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Software  Listings 
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The  programs  In  this  appendix  fall  Into  three  groups. 

The  first  three  programs  are  the  Vanguard  Analysts  Support  Tool  (VAST) 
and  two  utility  programs  which  support  that  program. 

The  next  two  programs  are  the  preprocessor  which  prepares  inputs  for  the 
data  reduction  program  (STF),  and  the  data  reduction  program  (STF)  Itself. 

The  last  three  programs  are  utility  programs  which  support  the  data 
collection  effort. 
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Program  Name: 

Vanguard  Analyst  Support  Tool  (VAST) 

Language : 

BASIC 

Machine : 

Apple  Macintosh 

Purpose : 

Calculates  mission  effectiveness  measure  from  capabilities 
entered  into  mission  hierarchy.  Datasets  represent  sets 
of  capabilities  from  combinations  of  programs.  User  can 
create,  modify  or  view  datasets,  perform  sensitivity 
analysis  on  a  dataset  or  compare  two  datasets. 
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G  0  S  U  8  House*  e  ep  mg 


'Put  up  Menu  end  First  Sc r»#« 


M  a  mL  me  Log  ic  : 

WHILE  I  >1 
id  It : 

a  e  n  u  n  va  b«r  »  M  EN  U  <0  ) 

U  H  ILE  a  tnuAVR  b*r  *  0 

•  rnunua  btr  ■  M  ENU<0) 

•  tan  ite  a  *  M  EN  U  <1  ) 

U  EN  0 

IF  a  tnunua  bfr  )  4  THEN  idlf  'return  tow  b  1 1  •  loop 

FOR  a  • !  TO  2  :MENU  a  ,3,0  :  N  E  X  T  a  'disebla  a  met 

MENU  3  ,0  ,1  :F0  R  a  *  I  TO  3  :MEN  U  3,a  ,MEXT  a  'ene  b  If  p  r  in  t  sc  r  f  f  n 

ON  a  enunua  ber  G  0  S  U  8  helpscreens.dataa  enu,  specula  e  n  u  ,e«  i  ta  mu 

FOR  a  *  1  TO  2  :MENU  a  ,9,I:NEXT  a  'eneble 

FORa  -  I  TO  3  -.MENU  3  ,«  ,1  :N  EXT  a  'amis 

G  0  S  U  8  F  irs  tScre  e  n 

W  EN  0 

'Mf  iMifMMimtmd  ot  Min  Line  Logic  MMifmimmimiif 


help  screens: 


MENU  ON  'enebles  screen  copy  endeiit  froa  other  ■  odules 

6  0  S  U  6  M  einHelp 

MENU  OFF  'returns  a  enu  control  to  polling  routine  in  Mem  Line 
R  E’T  U  RN 


da  t  aa  enu: 


MENU  ON  'enebles  screen  copy  end  eiit  froa  other  m  odules 

ON  a  enuitea  G  0  S  U  8  e  n  ter  new  , editold.show  datesets 

MENU  OFF  'returns  a  enu  control  to  polling  routine  in  Mem  Line 

RETURN 


spec  if  la  enu: 

MENU  ON  'enebles  screen  copy  end  e  *  ♦  t  froa  other  a  odules 

ON  a  enuitea  G0SU6  sensitivity,  con  pare,setm  mvelues,screencopy 
MENU  OFF 


RETURN 


eiita  « nv : 

GOTO  endit 

'eteeteTAe  toll ow  mg  «k  oduift  irt  th«  individual*  mu  i  tea  s*tt»»tttt»t« 

N  a  i aH  *  If  : 

U  INOOU  1  „<50  ,50  >-<4  5  0  ,32  3  ), -2 

PRINT  'The  Data  Function  allow  s  you  to  look  at  existing  Oata* 

PRINT  'S  e  t  s ,  c  r e  a  te  a  e  w  0  a  ta  S  *  t  s  or  a  od  i<y  1 1  is  t  mg  ■ 

P  R  INT  *0 a  t a  Se  ts.* 

PRINT  *Eac  A  Oata  Sft  contains  capability  ratmgs.node  by  node/ 

PRINT  'that  correspond  to  a  con  b  in  a  t  iok  o  1  p  rogr aw  s  .  * 

PRINT  *T  A  e  Special  Functi on sNenu  allow  s  you  to  do  Sensitivity* 

PRINT  ‘Analysis,  to  Co*  part  Oata  Stts,  and  to  mi  me  the  cast* 

PRINT  *in  w  h  i  c  h  all  capabilities  are  set  at  a  a  in  i*  u*  .* 

PRINT  'You  can  also  print  any  screen  <ro*  the  Special  Functions  Menu.' 

BUTTON  1  ,1  /o« '  ,<35  0  ,223  >-<3  7  3  ,231  ) 

U  MILE  DIALOG  (0)  <)  1  ;  J  £N0 

U  INDOU  CLOSE  1 

RETURN 

'eieeenMMti  ithis  routine  creates  and  nan  es  a  new  data  record  *e»§ 

e n  te  rn e w  : 

New  Nua  ber*Nua  berOfQataSets  ♦  i  'save  as  new  record 
NUNS  *  ST  R  %  (New  Nui  ber) 

New  N  a*  e  s  *  *0  a  t  a  Record  I  *♦  NUNI  :N  ew  OataSetRequested  *  1 
60SU6  New  Nan  eScreen  'allow  choice  oi  New  N«i  i! 

New  OataReentry: 

G0SU8  C  liooseE*  ist  mgO  a  taScreen  'allow  use  of  existing  data 

ResponseFlag  *  0  'Re sp on se f lag* 1  lor  OX, 2  for  CANCEL 

IF  ButtonpusAed*  1  THEN  GOSUB  SelectOata  s  IF  ResponseFlag*  2  THEN  GOTO  New  OataReentry 
ELSE  GOTO  ContinueKere 

IF  B  u  t  too  P  u  s  A  e  d  *  2  THEN  U  INOOU  CLOSE  2:F0R  i*l  TO  66  :  inval’d)*  0  :  ov  tv  a  I !  ( i)  ■  0  :N  EX 
T  i 

IF  6uttonPusAed*  3  THEN  U  INDOU  CLOSE  3:60SU6  seta  invalues 
C  on  t  in  u  e  H  e  re  : 

NANS*  New  Naa  e« 

U  INOOU  CLOSE  3 

CHAN6EFLAG*]  CA  a  n  g  e  f  lag  *  1  ii  cAinge  to  rusting  data 

UIN00U  CLOSE!  'set  or  new  data  set  requested 

ParentNode*XX  :  GOSUB  FILLTREE 
RETURN 
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Nfw  Ni*  tScrttn: 

U  IN  OOU  1  ,,(30  ,30  )-<  2  ?  0  ,1  30  )  ,4 
CALL  fl  OU  ET  0  (I  0  ,25) 

PRINT  *T  h  t  rfcordw  ill  b  #  storfd* 

PRINT*  w  1 1  h  t  h  t  follow  i  n  g  nan  f.“ 

PR  INT  *  Edit  this  if  you  likt.* 

EOIT  FIELD  3  Nn  f  t  ,(30  ,80  )  -  (I  40  ,?5  ) 
BUTTON  3  ,  t  ,*NA  ME  IS  DK",(150,8Q)-(240,?5),1 
U  NILE  OIAL06<0><>  1  :U  END 
NnNii  ft  «  E  O  IT  t  (3  )  :NAMt  *  NnNii  ft 
RETURN 


ChoosfEiistmgOataScrffn: 

U  IN  0  OU  3  ,,(20  ,1  5  0  )-(I  45  ,250  ), 2 
CALL  TEXTS  UE<I  2) 

PRINT  *Oo  you  w  ant  to  us#  an  * 

PRINT  *  f  i  is  t  ing  da  1 a  rf  c  or  d* 

PR  INT  *  to  start  w  ith’* 

FOR  1-1  TO  ••:INVAL*<I)«0:OUTVAL!U)MsNEXT  I 

BUTTON  1  ,1  ,*Y#  s  * ,( 1 0  ,37  >-(3  0  ,73  ),3 

8UTTON  2, 1,  *No*. (80  ,57  )-(l  2  0  ,73  ),3 

BUTTON  3  ,1  ,*Us  f  Mini*  urn  Rangfs*,(0,82)-(I  45  ,98  ),1 

Activity  -  DIALOG(O) 

U  MILE  Activity  (>I  Activity  «  DIALOS(0):UEND 
Buttonpushf  d-0  IA  LOS  (I  ) 

RETURN 


sfta  inviliff  t 

GOSU8  C  a  lc  •  la  t  in gM  #  s  s a  gf 
FOR  i- 1  TO  88 

IN  V  A  L  I  <  ■ ) XR  V  !  ( t  ,1 ) 

N oC  a  Ic  F  la gZ  ( i )*Q 
NEXT  i 
LL*  I  : U  L* 8  8 
GOSU8  INTERP 
S'  0  S  U  8  CALCALL 
U  IN  0  O  U  CLOSE  1 
RETURN 


Calculatingtlfssagf  : 

U  IN  0  OU  1  , ,(?5  ,1  0  0  )-(4  I  0  ,20  0  ), 2 

CALL  T  EXT  S  1 2  E  ( 1  8  >  :CL  S  :PR  INT  *U  A  S  T  CALCULATION  IS  UNDERUAT* 
P  R  IN  T  :P  R  IN  T  *  P  U  asf  U  a  1 1* 

RETURN 


f  d  *  to  Id  : 


d  Nfw  Data  Entry 


O 


S  0  S  U  6  $  *  le c  to*  U 

IF  RfsponsfFlag*  1  THEN  GO  SUB  F  1 1  IT  re  * 
RETURN 


show  d a  t*  s  f  t s  : 

W  INOOU  2  ,*OA  T  A  SET  S  *,(30  5  ,40  )-<4  9  5  ,320  ),4 
CIS 

BUTTON  4  ,S  /?A  GE  FORU  A  RO  \<I0  ,22  0  )-<l  9  0  ,24  1  >,2 
BUTTON  7  ,1  /PA  GE  B  A  C  K  *  ,(  1 0  ,24  0  )-<  I  9  0  ,24  0  )  ,2 
BUTTON  B  ,1  /OK  *  ,<  1 0  ,24  0  )-<l  9  0  ,2B0  ),2 
CALL  T  EXT  FA  C  E  (I  ) 

CALL  MOVET  0<5,10) 

PRINT  *  F  x  is  t  in  9  0*t*  Sf  ts#:PR  IN  T 
PagfX  *  I 
Show  N f i tP  *q t : 

CALL  M  OV  ET  0  <1  ,40  ) 

F  irs  tX  *  1  0  •  P  agf  X  -  9 

IF  P*9»X*M*iP*gf$X  THEN  LastX*NuabfrOfOataSfts  ELSE  l  a  s  tX  *  F  irs  tX  ♦  9 
FOR  K  «  F  irs  IX  TO  L*stX 

GET  2  ,K  '5ft  tht  Rfit  0*t*  Sft  froa  the  0*t*  Fil* 

ON  A  M  ES*  0  A  $ 

CA  LL  T  EXT  S  12E(I  2) 

PR  INT  K  ;  ONAH  E* 

NEXT  K 

U  H  1LE  0  !A  LO  S  (0  )  <)  I  sU  EN  0 
8  u  t  ton  P  u  s  h  ?  d  *  0  1A  L  0  G  (1  ) 

IF  8u  ttonPu  $hf  d  *  B  THEN  RETURN 

IF  ButtonPushfd*  4  THEN  IF  PagfX  (HaiPagtsX  THEN  Pagt%*Pag«XM  ELSE  P  a  gt  X  *  1 
IF  ButtonPushfd  *7  THEN  IF  PagfX)!  THEN  P*gfX*P*9fX-l  ELSE  PagtX*naiPagcsX 
60T0  ShowNfitP*9f 
RETURN 


/**«i***iiii***f*»Follow  i  n  9  R  ou  t  tnf  Controls  Oita  Sft  Sflfct»on**** 

S  f  If  c  tO  *  t* : 

U  INO  OU  1  ,,(10  ,30  >-<290  ,320  ), 2 

CALL  TEXTFACE(O)  :PR1NT  :  P  R  INT  *Entfr  thf  '; 

CALL  TEXTFACE(1>:PR  INT  'NUMBER 
CA  LL  T  EXT  FA  C  E(0  ):P  R  IN  T  'of  an' 

CALL  TEXTFA  CE(I  ):PR  INT  'EXISTING 
C  A  L  L  T  EXT  F  A  C  E(0  ):P  R  IN  T  'OataSft' 

U  INOOU  3  , ,(20  ,1 5  0 )-(2  B  0  ,310), 2 

PRINT'  OATA  SET  SELECTION  *  :Nur  S  *  *2*  'dt  fault  is  BASEL  IN  E 

CA  LL  M  OV  ET  0  (5,33) 

PRINT  *Nm«  bfr  $f  Itctfd  ■* 

E  0  IT  FIELO  !  ,NUM  $  ,<  1 3  0  ,20  )- <  1  7  0  ,35  ) 

BUTTON  I  ,0  /0K',(15  ,40  )-(7  0  ,74  ),3 
BUTTON  2,0 /CANCEL  *,(!••  ,40)- <2  0  0  ,74  ),3 
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CALL  N0VET0(3, 120):  PRINT  #C  I  icl  ok  this  w  t  a  flow  to  i  If  IfCtiOR.’ 

0  1  dU  indow  *3  :C  urran  tU  indow  *2 
GOSUe  GETIO 

LOOP  : 

Activity  *  0  IA  L  0  G  (0  ) 

U  MILE  A  c  t  iv  i  ty  O!  A  N  0  A  c  t  iv  ity  03  :A  c  t  i*  ity*0  I A  L  0  G  (0  ):U  EN  0 
IF  Activity  ()  3  THEN  GOTO  TastBntton*  '3*  fans  inothtr  v  in  dow  selected 
T  a*  9*01  dU  i  a  d  ow  ;  0  1  dU  indow  *CoppantU  udov  :  C  o  pp a  n  tU  indow  «T  ?■  p 
01d8nttons*4-3»(01dU  indow  *2) 

C  vppan  tB  •  t  tons** -3  •  (Ciippan  tU  mdow  -2) 

FOR  i*0  IdB  g  t  ton  s  T  0  0  IdB  «  t  ton  $  ♦  I  :  I  U  T  T  0  N  i  ,0  :  N  EXT  i 
U  IN  0  OU  C«pp*ntU  mdow 

FOR  i*C  v  pra  n  tB  v  t  ton  s  T  0  C  u  pp  f  n  tB  •  1 1  on  s ♦  I  :  B  U  T  T  0  N  i,I:NEXT  i 
GOTO  LOOP 
T  a % tl u  t  ton  %  : 

8  o  t  tonP  g  sh  a  d  *  0  IA  L  0  G  (I  ) 

ON  8  w  t  ton  P • sh  a  d  GOT  0  OKBUTT  ON  ,CA  NCELBUTT  ON 

IF  Bn t ton P«s bad**  OR  B«ttonPnsbad*7TMEN  G  0  S  U  9  GET  10  R  e  an  try 

GOTO  LOOP 

OKBUTTON:  'this  code  ra  ids  the  ppopardatasat  into  tha  array  - 

'closas  the  U  indow  and  calls  the  first  1  e  j  e  1  of  the  ’par 

NUN  t  * E  0  IT  S  ( I  ) 

Nwm  bapEntapad*V A  L(NUttS) 

IF  Ngi  barEntaradd  OR  Ngi  b  a  r  En  t  a  r  a  d)N  nm  barO  f  0  a  ta  S  a  ts  THEN  Nun  b  a  r  En  t  a  r  a  d*  N  «•  bapOfOataSa 
ts:NUMS»  S  T  R  s  (Non  bapEn  tarad):  E  0  IT  FIELO  I  ,NU  MS, (130, 20  )- (170, 35  );  GOTO  LOOP 
UlNOOU  CLOSE  3;U  I N  0  0  U  CL0SE2.-WIN00U  CLOSE  I 
GOSUB  L0A00ATA 
P  apa  n  tN  oda  *  XX 

RasponsaFlagM  'sat  dag  (op  OX  pasponsa 
RET  URN 

LOA  00A  TA  : 

GET  2  ,V  A  L(NUNt) 

OA  T A  SET ♦  *  OBt 
NANS  *  OA  S 
FOR  1*0  TO  B  7 

NoCa  IcFlagX  <!♦!  )*  0 

INV  A  L  *  ( I  ♦  I )  *  C  V  S  («  10  i  (OA  TA  SETS  ,1  ♦(I»8),4)) 

'mval  is  the  valna  of  the  noda  input  by  the  gsap 
IF  INVAIMM  9  THEN  NoCalcFIagXdM  )*-I  :  INV  A  L  ! (I ♦  I  )* 0 
IF  INV  A  L  !(!♦!  )<Q  THEN  N  oC  a  IcFlagX  (!♦  I  )•-!  :  INV  A  L  f(lM  )*A  B  S  (INV  A  L  !<M  )) 

OUT  V  A  L  !(!♦!)  «  CV  S  (tt  10  %  (OA  TA  SETS  ,5*(I»8  ),4>) 

'outval  is  the  valoa  of  the  noda  aftap  the  calculation  is  com  plata 

NEXT  I 
RETURN 
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CANCEIBUTTON : 

U1NOOU  CLOSE  3:U  IN  0  0  U  CLOSE  2:UlNOOW  CLOSE} 
R  t spon $»F lag*2 
RETURN 


lists  th »  t  *  is  ting  Oita  . . . 

GET  10: 

U  IN  0  0  U  2  ,*0A  TASETS  *,<30  3  ,40  )-<4f5,32l),4 
CIS 

BUTTON  6  ,1  ,*PA  G  E  FO  RU  A  R  0  *  ,<1  0  ,24  0  )-<l  9  0  ,24  0  >  ,2 
BUTTON  7,1  ,*PA  6  E  BA  CK  \<10  ,26  0  )-<l  9  0  t2B0  ),2 
CA  LL  T  EXTFA  CEU  ) 

CALL  M  0  V  E  T  0  <5  ,10  ) 

PRINT  *  Ei  is  ting  Data  S  »  ts  * : P  R  IN  T 
Pag»X*l 
N 1 1 tP  ag t : 

CALL  rtOVETOU  ,40) 

F  irs  tX  *  l  0  •  P  ag»X  -  9 

IF  P  agtX  »h  **P  agtsX  THEN  LastX*Ny*  b#  r  0  f  D  a  ta  S  1 1  s  ELSE  .  a  s  tX  *  F  irs  tX  ♦  9 
FOR  K  *  FirstX  TO  LastX 

6  ET  2  ,K  'G»  t  th#  M»t  Oata  S»t  fro*  t  N  »  Oata  F>W 

ON  A  M  EM  OA  % 

CA  LL  TEXT  S  1 2  £  <1  2) 

PR  IN  T  KjONAMEf 
NEXT  K 
RETURN 


GET  10  R  •  t  ft  tr  y  : 

IF  BvttoiPwsfcfd  *4  THEN  IF  P  ag»X  <M  aiP  agtsX  THEN  P  ag*X  *P  agtX  ♦  1  ELSE  PagtX»l 
IF  BwttonPush»d*7THEN  IF  PagtX)l  THEN  Pag#X»Pag»X-l  ELSE  PagtZ*MaiPagtsX 
SOTO  NiitPagt 

'•»»!•••••••»•••••••••  tad  of  GET1D  root  in »  •*•••••••••••••••••• 

'himi  mi  »»  iiiimi  Mimd  data  s»  It  c  t  ion  rowtints***  ••••****•*** 

'm  •  1 1 1 1  i  »  »i  i  »  i  »  i  •  ill  tr»»  routints»ttttt»»t**»»*»t»»»»»t»»»t»t 

F1LLTREE: 

'this  mooule  creates  the  nodal  picture  ano  the  movement  ano  oata  entry  buttons 

U  IN  0  0 U  1  ,,(3,5>-<5Q  0  ,350  >,2 

FOR  NC  »1  TO  5  :'F1N0  NUMBER  OF  CH1LOREN  FOR  THIS  NOOE 
IF  C<PartntNodt,NC)  ()  0  T  H  E  N  Sum  btrOfCf'«dr#r*’ 

NEXT  NC 

C  1  *C  (Partn  tNodt  ,1 ) 
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C  2*C  (P  ip#  ft  tN  od«  ,2) 

C  3  *C (P ip*  n  tN  od*  ,3 ) 

C  4  *C  (Pip*ft  tNod*  ,4) 

C  5*C  (P  »p#n  tNod*  ,5) 

FlLLTREER*Eft  try: 

CALL  T  EXT  FA  C  E  <1  ) 

CALL  TEXTS  12  E  (?  ) 

CALL  H  0  V  E  T  0  (B  1  ,28  ) : P  R  IN  T  NNi (P  ap*ft  tNod*  > 

CA  LL  M  0  V  ET  0  <75, 42):  PR  1 N  T  L  E  F T  i  (N  A  ♦  (P  i  p* n  tN  od *  >  ,1  4  > 

CALL  H0VET0(124,2B>:  PRINT  *Boi  *;PiP*ntNod*  ; 

CALL  MOVETO(100  ,40>  rPRINT  USING  *•  •  •  .11  *;  1NV  A  L  MPipm  tNod#  > 

C  h*  c  lloi  *  P  ar*  n  tNod*  :G0SUB  8  ox  R  #  a  lCb*  c  t 

IF  B  oi  R  *  a  IS  w  *  0  THEN  P  1C  T  U  R  t  <72  ,30  >*•  DX 1  ♦  ELSE  PICTURE  (7  2  ,30  >  ,Boi  2  ♦ 

BUTTON  1  ,1  /UP\<75  ,45  >-(l  0  5  ,B0  ),1 
BUTTON  2  ,1  /IN*  ,(134  ,45  >-<l  4  4  ,B0  >,l 
BUTTON  2  0  ,1  /?\<11  2  ,45  >-<l  2  7  ,B0  >,1 

BUTTON  13,1  /RECALCULATE*, (325, 27>-(425,43>,l 
BUTTON  1  4  ,1  ,‘SA  V  E*,(325  ,50  >-(3  7  0  ,44  >,1 
BUTTON  15, 1  /RETURN  *,(32  5  ,73  >-<3  8  0  ,B?  >  ,1 

IF  Nua  b#pOKhildP#ft<5  THEN  LastNorn  a  1C  h  i  Id/.  *N  urn  b*pOfCbildP*ft  ELSE  LastNopa  alChild/.  *4 
FOR  ChildBoi  *  1  TO  LutNor*  a  1C  hi  Id*/ 

XC  on*  t  p*  !  0  ♦  (C  h  i  ldB  oi  - 1  )*  S  mc  ift  g :  YCopftfp*  117 
CALL  tt  OU  ET  0  (XCopft*p*4  ,YC  OPft  #p-2  > 

PR  1NT  NN4(C(Pap#fttNod#,Childboi>> 

CALL  tt  OV  ET  0  (XCopft#pM  ,YCoPft#p»  1  2) 

PRINT  L  EFT  ♦  (NA  4(C  (Pip* ft  tNod#  ,Ch  ildboi)>,l5  > 

CALL  H0VET0(XCoPft*p»53,YCoPfttP-2> 

PR  1NT  *Boi  *;C(Pip#  ft  tNod*  ,Ch  ildboi  >; 

CALL  H0VET0(XCoPft»p*2?,YCoPft*p»28> 

PRINT  USIN6  *•»•.•»*;  INVA  L!<C(Par*otNod*  ,CHildboi>> 

ChictBoi  *  C  (P  ip*  ft  tN  odt  ,Ch  ildboi  >  :  6  0  S  U  B  BoiR*alCh*ct 

IF  BoxRfilSw  «  0  THEN  P  1 C  T  U  R  E  (XC  op«  *  p  ,YC  opft  *  p  > ,  B  0  X  1  ♦  E  L  S  E  P  1 C  T  U  R  E  (XC  opft  *  p  ,YC  op  ft  *  p  >  ,9o 

.24 

CALL  H  0  V  ET  0  (XC  o Pft  •  p  ♦  8  0  XU  10  E/ 2  ,YC  OPn  f  p  - 1  > 

CA  LL  PENS  1 7  E  (2  ,2 ) 

CALL  L  IN  E  (0  ,-l  4  ) 

PENN0RHAL 

IF  FF4(C(Pap*ft  tNod*  ,Ch  ildbo*  >>  (>  *P  *  A  N  0  FFl  (C  (P  i  p*  n  tN  od*  ,Ch  i  Idb  oi  >)  ( >  *0  *  T  H  EN  BUTTON  (1 
♦  Child8o«>»2-l  ,1/0N  *  ,(XC  opi*  *  p  ♦  3  tYC  orn*  r ♦  3  5  >-<XC  OPft  *  p*  3  3  ,YCopft*p*50  > 

BUTTON  (1  ♦  C  h  i  IdB  o  i  )•  2  ,1  /IN*  ,(XC  op  n  *  r*  6  2  ,YC  op  ft  *  r  ♦  3  5  >-(XC  op  ft  *  r*  9  2  ,YC  op  ft  *  r*  5  0  > 

NEXT  C  h  ildB  oi 

8  u  t  tonN  y«  *22 

FOR  ChildBoi  *  1  TO  LiitNop*  a  1C  hi  Id*/. 
xCopntr*  1 1  •  <C  h  ddB  oi -1  )•  S  p  a  c  mo 
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BUTTON  6  «  ttonN  ua  ,1  /V,(XC  or  nerMI  ,YCoriirr05  >-(XCorner*  5  5  ,YC  orne  r*5  0  ) 
ButtonNu*  *  ButtonNum  ♦  1 
NEXT  ChildBoi 


IF  ParentNode  ()  9  GOTO  N  oS  c  e  ft  ar  ioB  ox 
XCorner*l92:  YCorner*  44:ChildBoi*5 
CALL  N  0  V  ET  0  <XCorner*4  ,YCorner-2  > 

PR  1NT  NN*(C(ParentNode  ,Ch  ildbox )) 

CALL  M  OV  ET  0  (XCornerM  tYCor»er*  1  2> 

PRINT  LEFTKNA  *  (C  (P  a  r  e  n  tN  od  e  ,Ch  i Idboi  >> ,1  4  ) 

CALL  NOVETO  (XC  or  ft  e  r  ♦  5  3  ,YC  or  n  e r -  2  > 

PR  INT  •Bo«*;C(P4rMtNod»  ,Ch  ildbox); 

CALL  NOVETO  <XCorner*29,YCorner*2B> 

PR  INT  lNVAL*(C(ParentNode,Childbox>> 

P  ICT  UREtXCorner  ,YC  or  ft  e  r )  ,B0X  2  * 

CALL  H  OV  ET  0(1  1  9  ,91) 

CALL  PENS  12  E  (2  +2 ) 

CALL  L  IN  E  (XC  orn  t  r- 1  21  ,0) 

PENNORNAL 

BUTTON  1  6  ,1  /L0  \(XCornerO  ,YC  orn  e  r  ♦  3  5  >-(XC  orn  e  r  ♦  3  3  ,YC  ornrrOO  ) 
BUTTON  19, 1  p*Hl*9(XCorR»r»4  2  ,YC  or  n  e  r  ♦  3  5  >-(XC  or  n  e  r  ♦  9  2  ,YC  or  n  r  r  ♦  5  0  > 
BUTTON  2  1  ,1  /?VXC  order  Mg  ,YC  orne  r^  35  >-(XC  orne  r0  5  ^Corner  0  0  > 


N oS c e n ar ioB ox :  'The  follow  mg  draw  s  the  lints  connecting  the  boits 

CALL  P  E  N  S  1 2  E  (2  ,2 ) 

CALL  N  OV  ET  0  (1  0  ♦BOXU  10  E/ 2,100) 

CALL  L  IN  E  (SPACING*  (Las  tNorA  a  1C  h  i  Id'/.  - 1  >  ,0  > 

CALL  N  0  V  ET  0  (1  1  9  ,100  ): 

CALL  L  IN  E  (0  t-l  7  ) 

PENNORNAL  'The  follow  mg  sets  u p  current  values  in  the  low  er  left  corner. 

CALL  N0VET0  (3, 230):CALL  TEXTS12EU0) 

PRlNT’Record  Selected  is  •♦NUN* 

PR  INT  '  '♦NAN* 

C  A  LL  M  0  V  ET  0  (5  ,27  0  ) 

PRINT  ‘SELECTEO  NOOE  is  •♦NN*  (S  e  lec  tedNode  ) 

P  R  INT  *  V  a  lit  -  •;  :P  HINT  U  S  IN  G  •»»»  .If;  1NV  A  L  MS«  lec  tedNode  > 

BUTTON  U  ,1  , 'Select  node  ",(7,30  0  >-(l  3  0  ,31  2),1 


'Tie  follow  mg  w  aits  for  a  button  and  then  branches  accordingly 
REA  06UTT0NS  : 

U  HlLE  0  I A  L  0  G  (0  >  ()  1:U  EN0  'loop  until  a  button  is  pushed 

BUTT  ONPUSHEO  »  0  1A  LO  G  (1  ) 

IF  BUTT  ONPUSHEO  -  13  THEN  U  IN  0  0  V  CLOSE  3:G0SUB  Che  c  lit  :U  IN  0  0  U  CLOSE  1  :  R  E  T  U  R  N 

IF  BUTT  ONPUSHEO  »  14  THEN  U  1N00U  CLOSE  3:  GOSUB  savit:G0T0  F1LLTREE 

IF  BUTT  ONPUSHEO  *  13  THEN  GOSUB  CalculatmgNessage:  GOSUB  CALCALL:GOT  0  F  ILLT  R  Et 

IF  BUTT  ONPUSHEO  *  16  THEN  S  e  1  e  c  t  e  dN  ode »  P  are  n  tN  od  e  :  C  A  L  L  NOVETO(5,2  70):CALL  TEXT  S  1 2  E 
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<1  0  >:  P  t  IN  T  -SELECTEO  NODE  is  '»NN  t  (S  e  lec  tedN  ode  ):  P  R  IN  T  ‘  Value*  • ;  :  P  R  IN  T  USING  IN 

VALMSf  lectedNode>:GOTO  REAO0UTTONS 

IF  BUTTONPUSHED  »  IB  THEN  1NV  A  L  !<7)  »  I  :CA  LL  M  0  V  ET  0  (XCorner*29,YCorner*2B)«P  R  INT  1 
IF  BUTTONPUSHEO  *  I?  THEN  1NV  A  L  '  (7)  ■  2  :CA  L  L  M  0  V  E  T  0  <XC  o r  n  e  r  ♦  2  9  ,YC  or  n  e  r  ♦  2  8  > :  P  R  1 N  T  2 
IF  BUTTONPUSHEO  *  IB  OR  BUTTONPUSHEO  ■  I?  THEN  GOTO  REAOBUTTONS 
IF  BuitonPushed  )  19  THEN  GOSUB  Boxscreen  :  G  0  T  0  ReadButtons 
IF  BUTTONPUSHED  MOO  2  »  1  THEN  GOTO  UPOOUN  'odd  button  pushed 
'even  button  pushed  n  eini  enter  data  value 
ENTERNOOE: 

ChildS  elected*  ■  IN  T  ((BUT  T  ONP  US  H  EO -I  )/2)  Mind  u  hich  bo«  w  as  picked 

IF  Ch  ildS  elec  ted*  *  0  THEN  EE  *  P  arentNode  ELSE  EE  *  C  (P  are  n  tN  ode  ,Ch  ildS  e  lec  t  e  d*  ) 

IF  FF$(C  (Paren  tNode  ,Ch  ildSe  lee  ted*  ))*‘0‘ T  H  EN  NE  ■  S  <C  <P  are  n  tN  ode  ,Ch  ildS  e  le  c  te  d*  )  ,1  ):GO  T  0  NO 
ENTRY 

GOTO  MYPOINTER 

UPOOUN: 

IF  BUTTONPUSHED  *  1  ANO  ParentNode  (  BB  THEN  ParentNode  ■  P(ParentNode,l):60T0  FlUTREE 

IF  BUTTONPUSHEO  *  1  THEN  MOUSE  OFF  :6  0  $  U  B  Check  it  :U  1NOOU  CLOSE  1  rRETURN 

IF  BUTTONPUSHEO  ■  3  THEN  ParentNode  »  CliGOTO  FlLLTREE 

IF  BUTTONPUSHEO  *  3  THEN  ParentNode  *  C2:S0T0  FlLLTREE 

IF  BUTTONPUSHED  *  7  THEN  ParentNode  *  C3:S0TQ  FlLLTREE 

IF  BUTTONPUSHEO  *  9  THEN  ParentNode  -  C  4  :  G  0  T  0  FlLLTREE 

MYPOINTER:  'open  the  data  entry  w  indow  ,  Initialize  w  indow  values  and  text 

U  IN  0  0  U  3  ,,(133  ,200  >-(463  ,320  >,2 
VLOU  '*  RV  *  (EE  ,1 ) 

FOR  TEMP  *  6  TO  2  STEP  -1  'FIN 0  HIGHEST  RANGE  VALUE 
IF  R  V  !  ( EE  ,  T  E  M  P  )  )  0  THEN  GOTO  HIGHEST 
NEXT  TEMP 
HIGHEST  : 

V  H  1G  H  1  *  RV  ! (EE  ,TEM  P  ) 

VCURRENT  '«  1NVALMEE) 

IF  VH1GH!)VL0U  'THEN  V  M  A  X  !*7  H  IG  H  !  :V  M  IN  !*V  L  0  U  ! 

IF  VH16HMVL0U  'THEN  VMAX'-VLOU  1  :V  M  IN  !*V  H  IG  H  ! 

IF  VCURRENT!  )  VMAX'T  HEN  VCURRENT'  *  VM  A  X' 

IF  VCURRENT!  (VM  IN' THEN  VCURRENT'  *  VM  IN' 

BUTTON  1  5  ,1  /OK  *,(18  ,1  0  3  )-(3Q  ,1  1  9),3 
BUTTON  16,1  /CAN  CEL*  ,(70  ,1  0  3  >- ( 1  3  0  ,11  9  >  ,3 

IF  NoC  ale  Flag*  (EE)  *  -1  THEN  BUTTON  1  7  ,1  /Re  lease  V  a  lue  \(1B  0  ,1  0  0  >-(3  0  0  ,1  1  6  ),1 
CALL  M  OV  ET  0  (3,1B) 

CALL  TEXTS  12  Ed  8) 

PRINT  *N  0  0  E  NUMBER  »  *  ;NN  S  ( E  E  ) 

CA  LL  M  OV  ET  0  (3,40) 

P  R  INT  ‘VALUE  IS  * ;  :P  R  INT  U  S  IN  G  ‘I  I  •  .11  *;  1NV  A  L  !  (EE  > 

IF  NoC  alcFlag*  (EE)  ■  -1  THEN  C  A  LL  M  OV  ET  0  (1  7  0  ,4  0  ):CA  L  L  T  E  X  T  $  1 2  E  ( 1  2  >  :PR  IN  T  ‘Value  is  he  Id 
constant*; 
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CALL  MOV  ET  0(40  ,75  )  'ORAU  RANGE  LINE 
CA  LL  PENS  1 2  E  (1  ,3) 

CALL  L  IN  £  (0  ,5) 

CALL  L  IN  E  (1  0  2  ,0 ) 

CALL  L  IN  E  (0  ,-5) 

CALL  T  EXT  S  WE  (I  •  >  '  U  R  IT  E  EN  0  VALUES  Of  RANGE 

CALL  MOV  ET  0  (3  0,74) 

PRINT  VLOU  !; 

CALL  M  0  V  ET  0  (1  32  ,74  ) 

P  R  IN  T  V  HIGH 

If  VH16H'-VL0U  1 «  0  THEN  XP  0  S  IT  ION  «0  ELSE  XP  OS  IT  ION»  I  0  G  MV  C  UR  R  ENT  !-V  LOU  !  )/<V  H  1G  H  ! -V  L  0  U 

) 

CA  LL  PENS  1 2  E  (3  ,3)  'draw  p  r» 

CALL  M  OV  ETO  <4  0  ♦XPOSIT  ION  ,B4> 

CALL  L  IN  £  <•  ,15) 

CALL  M  OV  ET  0  <4  0  MPOS  ITION  ,84  > 

CALL  L  IN  E  (5  ,7) 

CALL  M  OV  ET  0  (4  0MPOS  IT  ION  ,B4  > 

CALL  L  IN  E  (-5  ,7) 

G  ET  (35  *XP  OS  IT  ION  ,84  )-<4  7  ♦  XP  0  S  IT  ION  ,10  1  >,PP 


10LE.P0  INTER  :  'RESPONO  TO  MOUSE  ROUTINE 

U  H1LE  M  OUSE(Q>«>0 

0*  0  I A  L  0  G  (0  ) ;  8uttOftPushfd«  OlALOG(l) 

If  8u  ttonPusM  d  «  IS  THEN  GOSUB  C  h  *091 V  *  lur  :U  IN  0  0  U  CLOSE  3:G0T0  F  ILLT  R  EER  t  E  ft  tr  r 
IF  ButtonPushfd  »  16  THEN  U  1NOOU  CLOSE  3:GOTO  F  1LLT  R  E E R  r  E ft  tr y 

If  8u  ttoftP  wshed  «  17  THEN  N  oC  1 U  f  U9X  (EE  >«0  :  C  H  A  N  G  E  F  LA  6«  1  :U  INOOU  CLOSE  3  :  G  0  T  0  F 

ILLT  R  EER  f  Eft  try 
U  ENO 

If  (M  0  U  S  E(3XXP0S  IT  ION  ♦  3  5  )  0  R  (M  0  U  S  E  (3  )>XP  0  S  IT  ION  ♦  4  7  )  T  H  E  N  GOTO  IOLE.  POINTER 

If  (M  0  U  S  E  (4  )( 8  3  )  OR  (M  0  U  S  E  (4  )>I  0  2  )  T  H  £N  60T0  IOLE.  POINTER 

If  MOUSE(5))148  OR  MOUSE(5  )(40  6  0  T0  IOLE. POINTER 
0L0M0USE«M0USE(3) 

If  A  B  S  (M  0  U  S  E  (S)-OLOM  OUS  E)(l  THEN  GOTO  IOLE. POINTER 


M  ov t  .Mow  %t  : 

If  M  0  U  S  E  (0  >■  )Q  60  TO  IOLE. POINTER  #  is  button  vtilldow  ft’ 

If  A  8  S  (M  0  U  S  E  (5  )-OLOM  OUSEX1  GOTO  Move. Mouse  'tu  s  1 1  »  ov  t  d  1 9  *  1  n  ’ 
PUT  <35  ♦XPOS  IT  ION  ,B4  )-<47  ♦XPOS  IT  ION  ,10  1  ),PP  'rr*sr  old  pom  t*  r 
XPOSIT10N«XPOSIT10N*M  OUSE(5)-OLOMOUSE  '9 ft  nr*  position 

If  XPOS  IT  ION  <0  THEN  XPQS1TION«0 
IF  XP  0  S  IT  ION  )1  0  0  THEN  XPOSITION-lOO 

PUT  (35*XPOS1TION,B4)-(47»XPOSIT10N,10I  i.PP  'driw  ftfw  poifttfr 
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VCURRENT  !*VLOV  !  *XP  0  S  IT  ION  •  (V  H  IS  H  !-V  L  0  U  !)/lOQ  'recalculate  value 

CALL  M  OV  ET  0  (3  ,40  ) 

CA  LL  T  EXT  SWE(IB) 

PRINT  ’VALUE  IS  ’ ;  :  P  R  IN  T  U  S  IN  6  ’•  I  •  .1 1  * ;  V  C  U  R  R  EN  T  ! 

OlOM  OUSE*M  0  U  S  E  (3 ) 

GOTO  Move. Mouse 


C  h  an  gf  V  a  lu  t : 

1NVALMEE)  *  VCURRENT  * :  CHANGEFlAS  -  I 

IF  F F i <EE  )< ) *P  *  T  H  EN  N  oC  a  lc  F  UgX  (EE  >*-!  'chang  ing  value  of  a  non-pri*  itive  sets  the  No  Calc 
u  la  t  ion  F lag 
RETURN 


NO  ENTRY:  'THIS  MOOULE  CHECKS  FOR  THE  NOOE  SELECTEO  FOR  INPUT  BEING 
'A  0  U  P  L  1C  A  T  E  ,  A  N  0  ASKS  IF  THE  USER  U  ANTS  TO  CANCEL  ENTRY 
'OR  JUMP  TO  THE  OR  16  IN  AL  NOOE  FOR  ENTRY 

U  1NOOU  3  ,,(  15  3  ,20  0  )-  (4  65  ,3  2  0  )  ,2 

PRINT  :PR  IN  T  ’THIS  NOOE  IS  A  0  U  P  L  1C  A  T  E  0  F  N  0  0  E  *  ;NN  i  (N  E  ) ;’  !!’ .-PRINT  ’SELECT  THE  BUTTON  OF 
YOUR  CHOICE’ 

BUTTON  1  3  ,1  ,’JUM  P  T  0  OR  IG  IN  A  L\<ll  ,5i  >-<2  0  0  tU  >,3 
BUTTON  1  4  #1  ,’CANCELVIO  ,B0  >-<73  ,PO,3 

U  H  1LE  0  IA  LO  6  <0  >  <>  1  :U  EN  O 
T  H  ISBUTT  ON  «  O  1A  LO  6  <1  > 

IF  TH  IS  BUTTON  *  14  THEN  U  IN  O  0  V  CLOSE  3  : 6  O  T  O  REA08UTT0NS 
IF  BUTT  ONPUSHEO  *  2  THEN  U  1NOOU  CLOSE  3  :  B  O  T  O  FILLTREE 
ParentNode  *  NE;U  1NOOU  CLOSE  3  :  C  O  T  O  FILLTREE 

'•••••••••••••••••end  all  tree  routinesf***»*********e******eeee* 


BoiRealCheck: 

8  o  k  R  e  a  ISw  *0 
FOR  i  *  1  T  O  37 

IF  CUfCKEBos  *  RealBoiti)  T  HEN  BoiRealS*  *1  :  R  E  T  U  R  N 
NEXT  i 
RETURN 


C  h  e  c  It  1 t : 

IF  CHANGEFLAG  «  0  THEN  RETURN 
U  INOOU  3  ,,<17  3  ,20  0  >-<430  ,330,2 
CALL  MOVETO<B,10):CALL  TEXTS  12  ECU) 

CALL  T  EXT  FA  CE<1  >  :PR1NT  ’This  dataset  has  been  changed,’ 
PRINT  ’Op  a  New  Data  Set  w  as  Requested. *:CALL  T  EXTFA  CE<0> 
BUTTON  1  3  ,1  ,’Save  C  h  an  g  e  s  ’  ,<1 0  ,33  >- <2  3  0  ,30  >,2 
BUTTON  1  6  ,1  , ’Abandon  Changes’, <10  ,60  >-<230  ,73>,2 
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A  c  1 1*  itr -0  1 A  L  0  6  (0  ) 

U  HUE  Activity  <)1  iA  c  tiw  i  ty-D  1A  LOB  (0  ):U  EH  0 
Buttonpushed  *  D  IA  L  0  G  (1  )  :U  INOOU  CLOSE  3 
IF  Buttonpushed-  13  THEN  GOSUB  SA  V  IT 
RETURN 


'•••••••••••••save  data  set  i 

S  A  V  IT  :  'HAKE  0ATAF1LE 

IF  New  OataSetReauested  *  1  THEN  NUHS*STR$(NevNuBber):6DSU8  NtvNai  •  S  c  re  a  n  :  6  0  T  0  sa 
u  1 12 

UINOOU  3  ,,(17  5  ,20  0  )-(4  50  ,330  )  ,2 
CALL  HOVETO(8,10):CALL  TEXT  S  UE  (12  ) 

CALL  TEXTFACE(l)  :  P  R  IN  T  ’PI****  choose  a  save  opt  ion* 

C  A  LL  T  EXT  FA  C  E  (0  ) 

BUTTON  1  5  ,1  ,*Sa  v  a  w  1 1  h  currant  record  ma  bar  and  naa  a  *,<! 0  ,35  )-  (2  5  0  ,30  ), 2 
BUTTON  17, 1  , "Change  III  •  record  ui  e\<10  ,85  >-(2  5  0  ,1  0  0  >,2 
BUTTON  1  i  ,1  , ’Create  a  law  da  ta  rac  ord\<H  ,40  )-<2  5  0  ,75  >,2 
A  c  1 1  v  i  t  y  *  0  1A  LO  G  (0  ) 

U  H1LE  Activity  (>1  :A  c  t  iw  ity-0  1A  L  0  G  (0  ):U  EN  0 
B  u t  tonpy shed  *  0  IA  L  0  G  (I  ) 

IF  Buttonpushed-  15  THEN  GOTO  S  a  v  i  1 2 

IF  Butt  on  Pushed  -  I  6  THEN  Ne*Nu»ber«Nu»berOfOitaSett  ♦  1  s  Nui  >  *  ST  R  i  (New  Nua  bar)  : 
GOSUB  New  Naa  aScraan  :  G  0  T  0  sav  1 1 2 

IF  Buttonpushed  -  17  THEN  New  Nil  as  >  *0  a  t  a  Record  •'  *  Nub  S 
U  INOOU  CLOSE  3 

GOSUB  New  Naa  aScraan  :Nai  t  >  Niw  Naa  at 
S  a  v  1 1 2  : 

UINOOU  3  ,,(175  ,20  0  >-<4  5  0  ,330  ),2 
CALLMOVETO(8,!0):CALL  TEXT  S  12E<1  2> 

CALL  T  EXT  FA  C  E(1  ) 

P  R  INT -SAV  ING  DA  TA  RECORO  *:PR  IN  T  *  Please  Uaif 
GOSUB  UriteFile  :U  INOOU  CLOSE  3 
RETURN 


U  r  1 1  a  F  i  I  a : 

OS  «  •• 

IDs  -  NAHS 
FOR  1  -  1  TO  88 

IF  NoC  alcFlagZ  (l)--l  THEN  !NVAL!<1)«  -INUAL'(I) 

IF  IN  V  A  L  '  ( I  )-0  THEN  IF  N  oC  a  lc  F  lagX  (I)--l  THEN  INVALID-  -99 
At  «  HKSs(  INVALID)  :8s  -  H  K  S  S  (OUT  V  A  L  !<1)) 

Ct  *  as  •  8s 
D s  «  Os  ♦  C s 
NEXT  1 

LSET  OAS  »  10S.-LS  :*  :  =s  -  OS 
P  U  T  2  ,VA  L  (NUH  s; 
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N  u  •  btrDfOataStts  ■  LOF(2)/730 
CHANGEFLAG  *  0  :NtwOaUSttRtqvtsttd«  0 
RETURN 


•  mit  iMitMd  sivt  data  r  od«l»s»»»»»i#»MiM  m  mmmimm 

BotScrvvn: 

IF  B  u  t  toi  P  u  s  h  t  d  *  20  THEN  CIickBot  ■  PtrtatNodt 
IF  B  u  t  ton  P  u  s  h  t  d  *  21  THEN  CIickBoi  «  7 

IF  ButtonPushtd  )2l  THEN  C  lick  B  o*  ■  C(PartntNodt,  ButtonPushtd  -  21) 
G  ET  I  4  'Ciickbot 
T  t 1  tS  tr  ingi  *  T  •  tA  ♦ 

S  c  rt  t  ft  2*  «  M  10i<Tt«tStriftgif45l  ,43  0  ) 

I  int  c  ou  n  t  *  0 

U  INOOU  4  ,,U3  3  ,21 1  )-<4  4  5  ,32  0  )  ,2 
FOR  k  ■  1  TO  2 

IF  I  •  2  ANO  Scrrra2t  «  Blank  Strings  THEN  GOTO  NnK 
CALL  nOVETO  (1  0  ,10  ) 

FO  R  i  «  1  T  0  i 

1 1 1 1  ♦  ■  fi  IDi(TtitStringi,Iifttcouftt*75  ♦  1  ,75) 

P  R  IN  T  tri  tt 
lint  coun  t  *  lift  tcowft  t  *  1 
NEXT  i 

BUTTON  i  , I, ‘OK*, (10  ,1  0  3  )-  <3  0  ,Ilt) 

U  HUE  OIA  106(0)01  :U  EN  0 
NttK:  NEXT  k 
U  1N00U  CLOSE  4 
RETURN 


it  ft  i  i  t  iv  i  ty  t 

IF  srnsitivityfirsttiat  ()  0  THEN  GOTO  btginSrnsitivity 
it n i  itiv i tx 4 irstt  is  t  ■  I 
U  IN00W  I  , ,(25  ,25  )-(5 0  0  ,325  ), -2 
CALL  M  0  V  E  T  0  (5  0  ,50  ) 

PRINT  *S  r  ft  s  i  t  iv  i  ty  Analysis  isconctrntdw  ith  tht  t  f  f  t  c  t  that  im  p  r ov  t  ■  t  ft  t  s  * 
PRINT  *m  ft  im  i  t  iv  t  nodts  at  tht  bottom  o  f  tht  trtt  havt  on  hightr  Itvtlnodts,* 
PRINT  *sptcifically,on  tht  follow  « ft  g  :  * 

P  R  INT  *  Nodt  I  I  I  I  :MU  C  Oata  <7.  Com  pit  tt)* 

PRINT  *  Nodr  I  I  2  I  :  C  IN  C  A  strttft  tat  (Cos  plrttnns  of  Inform  atioft  to  support)* 

PRINT  *  Nodt  2321  : Attack  Characttrization  (7  Com  plttt)* 

PRINT  *  Nodt  I  :Forcr  U  arning  * 

P  R  IN  T  *  Nodt  2  :  E A M  * 

P  R  IN  T  *  Nodt  0  ;SAC  Mission  Ualut* 

BUTTON  I  ,1  ,*ok*,(27  5  ,1  5  0  )- (3  0  0  ,1  7  5  ) 

U  H  IL  E  0  IA  L  0  G  (0  )  ()  I  :  U  EN  0 
CALL  N0UET0  (3  0  ,50  )  :C  LS 
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PRINT  'Pop  the  diti  i*  t  you  w  r  1 1  it  l»c  t,  tfcii  function  prints  th#  current  v*  Ui  * 

PR  INT  'of  each  of  tbdv  nodes. 

PRINT 

PR  [NT  'Thru, for  tech  prm  ittvt  nod*  that  ti  involved  in  the  cikulihon,  it* 
PRINT  *u1c«lat«l  the  Li  p  r  o  u  t  n  t  n  t  in  each  o  f  t  h  t  above  n  o  d  *  5  that  t  h  t  best* 
PRINT  ’possible  vi  Ui  of  the  pfn  i  tire  node  *  ou  Id  product,  m  i  IK  ill  Other  nodes' 
PRINT  ’uftchaaged,  It  prin ti  the  ooi-itro  m  prove*  to ti." 

PIIRT 

PRINT  ‘This  iftfor*  a  t  ion  -  ill  not  br  disp  lay  »d  age  m , bv  t  is  print  to** 

SUTTON  1  vl/ol  ",<273  ,131  M3 10  ,173) 
y  HUE  0  IA  LOG  <B)  O  I  :U  END 
U  IN  DOW  CLOSE  1 


be  g  in  S  e  n  s  1 1 1  v  i  ty  : 

U  IN  0  D  U  1  VI(I0  0  .11®  >-<4  0  •  ,30  0  ),-2 
CALL  TSXTSIIEUO 
CALL  H  D  V  ET  0  <1  ,20  ) 

PRINT  '  You  •  vs  t  p  ick  i  DataSet* 

PRINT  *  f  or  se  n  s  i  tin  ity  in  a ly  s  is  .* 

CALL  T  EXT  FA  CEd  ) 

SUTTON  1,1  ,'DX  \(I7  0  ,110)- (170,125) 

CALL  TEXTFACE(O) 

BUTTON  2  ,1  /Cancel*, (120  ,150  )-<220  ,170  ) 

A  c  1 1 v i ty*  0 

U  H  ILE  A  c  tivityOl  iA  c  tivityO  IA  L0  6  (0  ):W  EN  0 
8  u  ttonP  v  sh  ed  *  D  IA  L  0  6  (I  ) 

IF  SuttonPvshed  *  1  THEN  GO  SUB  SelectDitiELSE  RETURN 
IF  RtsponseFlag-2  THEN  RET  URN 

W  IN00U  CLOSE  1  :W  IND0W  C  L  0  S  E  2  :W  IN  D  0  U  CLOSE  3 
W  IN  DOW  1  ,,  (50  ,1  0  0  )- (45  0  , 30  0  )  ,2  :  C  A  L  L  TEXT  FACE  <9 ) 

CALL  TEXT  S  12  E  <1  4):CLS  :PR  INT  ;PRINT  *  SENS  IT  IV  ITY  ANALYSIS  CALCULATION' 

PR  INT  *  IS  UN0ERU  AY* 

PRINTjPRINT*  Please  U  ait’  :C  A  LL  T  EXT  S  12  E  <  1  2  )  :  C  A  L  L  TEXTFACE  (0) 

B9  !*INVA  L,(9):B2  3  »*INVA  L  !  ( 23  )  :B3  2  !*1NVA  L’<32) 

8  5  9  !*INV  A  L  !  <59  )  :B8  4  !*INV  A  L!(B6):8B  B  **INV  A  L  1  (8B  )  'hold  'base  line*  values 


LP  R  INT 
LP  R  INT 
LPR  INT 
LP  R  INT 
LP  R  INT 
LPR  INT 
LPR  INT 
LPR  INT 
LPR  INT 


CHRM12):LPRINT:LPRINT*SENSITIVITYANALYSIS#  :  L  P  R  INT 
'Sensitivity  Analysis  is  concerned**  ith  the  effect  that  t*  prove*  ents* 

*  in  pri*  itive  nodes  at  the  botto*  of  the  tree  have  on  higher  level  nodes,* 

'specifically, on  the  folio**  mg:* 

*  Node  1  I  I  1  :MU  C  Oata  (7.  Co*  plete)* 

*  Node  I  I  2)  :CINCN0RA0  Assess*  ent  (Co*  pleteness  of  Inform  a  t  ion  to  support)* 

*  Node  23  2  1  :N0RA0  Attack  Characterization  (X  Co*  plete)* 

'  Node  1  :SAC  Force  U  arnmg  ' 

'  Node  2  :SAC  EA  n  ' 
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LP  R  IN  T  '  Node  0  :SACMission  Valve' 

LP  R  IN  T 

LPRINT  'For  the  data  set  you  w  ill  se lec  t,  th  is  fun c  t ion  prints  the  current  v  a  1  u  •  * 
LPRINT  'of  each  of  these  nodes. 

LPR  INT 

LPRINT  'Then,  for  each  p  r  ia  itive  node  that  is  involved  in  the  calculation,  tt* 
LPRINT  'calculates  the  ia  prove*  ent  in  each  of  the  above  nodes  that  the  best* 
LPRINT  'possible  value  of  the  pna  itive  node  w  ovId  produce, w  ith  all  other  nodes' 
LPRINT  'unchanged.  It  prints  the  non-iero  i*  prove*  ents.* 

LP  R  INT 

FOR  i  *  2  4  TO  I  STEP  -I 

IF  M  ID  I  (n  a  a  S  ,i  ,1)  <)  '  'THEN  SOTO  sh  if  tnan  el 
NEXT  i 


shiftnaa  el  :naa  iS  ■  LEFTS(naa  S,i) 

LP  R  INT  :LP  R  INT  'The  Baseline  V  a  lues  for  Da  ta  Set  ';NAMXS  ,  •  are:' 

LP  R  INT  '  MU  C  (node  1  1  1  1  >  ■';  INVALM9) 

LPRINT  '  CINC  A  ssess  .(node  I  1  2  I  >  * ';  IN V  A  L  ‘ <23  > 

LPRINT  '  Attack  Characterization  (node  2  3  2  1  )  * ' ;  IN  V  A  L )  <32  ) 

LP  R  IN  T  '  Force  U  arn  ing  X  (node  I  >  *';  INV  A  L  *(59  > 

LPRINT  '  EAM  (node  2  )  »  ' ;  INV  A  L  1  <B4  > 

LPRINT  '  M  ission  V  alue  (node  0  )  *  '  ;INV  A  L  1  (BB  ) 

LP  R  INT 

LPRINT  'The  follow  ing  are  the  ia  prove*  ents  that  can  be  expected  in  the  above* 
LPRINT  'if  the  indicated  pria  itive  node  is  ia  proved  to  its  best  possible  value.* 
FOR  sidi  *  I  TO  L  0  F  <3  )/4  're ad  toend  of  indexfile 
GET  3  ,$idi 

lnde  x*A  B  S  (V  A  L(IXS>) 

IF  FFS  (Index  )()'P  '  T  M  E  N  Nextlndex 


Tea  p  •  ■  INV  AL!(!ndex)  'hold  'baseline*  value 

U  MILE  RV  !< Index  tj)  *  0  :  j« j-l  :UEND  'find  'best'range  valve 

INV  A  L  '(Index)  -  RV  Klnde  i  tj):S  0  SUB  CA  LCA  LL  set  value  and  c  a  leu  late 

FOR  i  «  30  TO  1  ST  EP  -l 

IF  M  10t(naS(index),iyl)  ()  •  •  THEN  GOTO  shiftnaa  e2 
NEXT  i 

shiftnaa  e2:naa  xS  *  LEFTt(nat(index),i) 


LPRINT  :LPRINT  'la  proving  the  valve  of  node  '  ;NNS  (lnde  x  );':  'nan  xSj'should  produce  the  fol 


low  ing:' 

IF  B  9  '  < )  In  v  a  I !  (9)  T  H  EN  LP  R  IN  T  ' 
IF  B  2  3  !  ()  In  v  a  I  *(23  )  T  H  EN  LP  R  IN  T 

B  2  3  ! 

IF  B  3  2  M )  In v  a  I !<32  )  T  H  EN  L  P  R  IN  T 
in  v  a  I  '(32  )  -  B32  ! 

IF  B  3  9  !  ( )  In v a  1 1  <39  )  T  H  EN  LP  R  IN  T 

59  • 

IF  B  8  A  '  ( )  Invat!(64)THEN  LPR  IN  T 


MU  C  (Node  I  I  I  I  )  mcresed  by:  ';  inv  a  I  !<9)  -  99' 

'  CINC  Assess. (node  I  121)  increased  by:  *;  in  *  a  I !  <23  >  - 

'  Attack  Characterization  (node  2321  )  increased  by:  * ; 

'  Force  U  arning  (node  I)  increased  by:  " ;  i  n  v  a  1  *  ( 59  )  -  3 

'  EAM  (node  2)  increased  by:  ”:invil’<B6)-  B  8  6  ' 
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IF  888*0  lno*I!<W>  THEN  L  P  R  IN  T 


Minion  Value  (node  0)  incrmrd  by  :  * ;  m v  a  1 1  <88  )  -  8 


IF  8  9  '  ■  IN V  A  L  ! (?)  AND  8  2  3'-  IN V  A  L  ! < 23  )  A  N  0  0  3  2'-  IN  V  A  L  ! (32  )  A  N  0  85?*-  IN  V  A  l  •  (5?  )  A  N  0 
8  8  6'-  i  n  v  1 1 !  (84  )  A  N  0  8  8  8  f  -  IN  V  A  L  !  (88  )  THEN  L  P  R  IN  T  S  T  R  IN  G  4  (2  5  ,*  *),*N0  DIFFERENCE* 

LPR  INT 

1NV  A  L  ?<lndt  i  )*T  ••  p  !  'reitore  *ba it  1  int *  v a lu  t 
NtitlndeirNEXT  tidi 
LPRINT  C  H  R  I  ( 1  2  )  :U  1N00U  CLOSE  1 
RETURN 


coa  part: 

U  1N00U  CLOSE  1  :U  INOOU  C  L  0  S  E  2  :U  IN  0  0  U  CLOSE  3 
FOR  icoA  p«  1  TO  2 

U  INOOU  1  ,,(10  0  #1M>-<4|0  ,30  0  )#-2 
CALL  T  EXT  S  12  E(1  4) 

CALL  H  OV  ET  0  (1  ,21  ) 

PRINT  ‘You  a  trsl  pick  lw  o  0  a  la  Sets* 

PRINT  *  for  aodt  by  n  odt  coa  p  ar  iioa  .* 

CA  LL  M  OV  ET  0  <5*10  0  ) 

PRINT  ‘Art  you  rtady  lo  pick  Data  Stt  I  '♦$  T  R  I  (icoa  ?)♦'?' 

CALL  T  EXT  FA  C  E  (1  ) 

SUTTON  1  ,1  ,*OK\(1?0  ,11  •>-<!?•  ,125) 

CALL  TEXTFACE(O) 

SUTTON  2  ,1  t"CiACr  I', (120  ,1  50  )-(2  20  *1  70  ) 

A  clivaly-0 

U  NILE  ActiuityOl  :Ac  1  iv  i  ly»  0  1A  LOG  (0):U  END 
8  «  t  ton  P  u  ih  e  d  *  0  I A  L  0  G  (1  ) 

IF  8  u 1  Ion P  v ik  t  d  -  1  THEN  60SU8  S  t  ltc  10  ala  ELSE  RETURN 
IF  RtiponitFlag*  2  THEN  RETURN 
IF  ic  oa  p  *  1  THEN  niA  II*  a  a  a  l  ELSE  iua  21  *  nan  I 
IF  <  c  o  a  p  *  1  THEN  FOR  J-I  TO  88:1NVAL1  '(J)*1NV  A  L  MJ):N  EXT  J 
NEXT  <c  oa  p 

U  INOOU  CLOSE  1  :W  INOOU  CLOSE  2  :U  INOOU  CLOSE  3 
U  INOOU  1  ,,(95  ,10I)-(4  1  0  ,20  0  ), 2 

CALL  TEXT  S  1ZE(1  4  )  :C  L  S  :PR  INT  *0ATA  SET  COMPARISON  IS  UNOERU  AY- 
PR  IN  T  :PR  IN  T  *  Pltast  Uait*:LPRlNT  C  H  R  4  (1  2  ) 

LPRINT  *0  A  T  A  SET  C0MPAR1S0N*:LPR!NT 
p  1  in r Is  S  T  R  IN  G  I  (79  ,*  *) 

M  1 0  I  (p  1  in  r  1 ,1  )  *  *N  0  0  E  "  :M  l  D  4  (p  I  in  t  4  ,9)  ■  'Node  NaA  t • 

FOR  i  -  24  T  0  1  STEP  -1 

IF  M  10  4  (naA  1  4  ,i,l)  ()  *  'THEN  GOTO  ik  if  In  a a  t 
NEXT  i 

ik  if  tn  a  a  t :  n  a  a  if  *  LEFT4(naA  1  4  ,i) 

M  10  4  (p  line 4  ,45  -  i)  ■  naA  i4 
M  10  4  <p  1  mr  4  ,54  )  ■  naA  2  4 
L  P  R  IN  T  p  liar4 

FOR  la  1  TO  lOF(3)/6  're  ad  to  tndof  mdti  f  lit 
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GET  3  , 1 
L  P  R  IN  T 

p  lines  -  $  T  R  IN  6*  <38 
In  d  e  x  *  A  8  S  (V  A  L  (IXI )) 

IF  INV  A  L I  Kind*  t )  >  INV  A  L ! (Index  >  T  K  E N  INI »6T  s  ELSE  IF  INV  A  U  !<Inde  i  )  «  IN U  A  L  f  (Indr  *  )  T  H  E 
N  INI  ■  *  «  'ELSE  INI-LTI 

IF  rv  '(inde  i  tI  )  )  rv  I  (index  ,2)  A  N  0  ini  -  GTi  T  H  EN  inf  «LTi  E  l  S  E  I  F  rv  !  <  mde  *  ,1  )  )  rv  !  <  indr  i  ,2 ) 
A  NO  iftf  »  LTl  THEN  in*  «GTf 

H  lOMplinet,!)*  NN I  ( inde  x  )  :  M  I0f(plinel,9)«  mt(iftdfi)  :  L  P  R  IN  T  p  I  i  ne  f  ; 

L  P  R  IN  T  USING  *•••  . •  •  * ; INV  A  L 1  ! (Inde  x ) ; 

L  P  R  IN  T  INI; 

L  P  R  IN  T  USING  INV  A  L  fdide  x  >; 

IF  rv  ' ( inde x  ,1  )  )  rv f( inde x  ,2)  T  H E N  IPRINT  -  (Less  is  better)'  ELSE  LPRINT  ■  ■ 

NEXT  I 

IP  R  INT  C  H  R  l  <1  2)  :U  IN  0  OU  CLOSE  I 
RETURN 


sc  re  e nc  op  r  : 

LC  OPT 
RETURN 


e  ndit: 

MENU  RESET 
CLOSE 
SYSTEM 
ENO 


ENO  M  ENU  STUFF 


'••••t*»»aar»»ffnod»  calculation  routines********** 


CALCALL: 


'•••••set  all  scenario/ti*  e  nodes******** 

IF  in  v  a  1 !  (7)  »  0  THEN  mval!(7>  -  I 

INVAL'(18)*  INV  A  L  '(7)  :  LL*  1  8  :  U  L-  1  8  :60SU8  INTERP 
INV  A  L  '<2?  )  *  INVALM7)  :  LL«2  9  :UL«29  :G0SUB  INTERP 


'In  order  to  calculate  box  9,need  to  load  appropriate  scale  values  for  boxes 
'1,5,1  an d  8 . 

IF  in  v  *  1 M7)  «1  THEN  i«l  ELSE  i  «  2 
FOR  j  «  1  TO  I 

sc 1  <1 , j )  *  S4 ’(.,j):sc  *<5,J)  ■  S  5  !(i ,j> : sc  * < 6 , j )  *  S  i  Mi ,j>: sc  *<8,j)  «  S  8  •< .  ,j) 
NEXT  j 
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CALCN1 : 

LET  L  L  *  1  :  L  E  T  UL  ■  4  :  G  0  S  U  8  1NTERP 
'*»n*  CALCULATE  8  ox  8  RAU  SCORE  ***** 

IF  NoC  ale  Flag*  (B)  ()  -1  THEN  INV  A  L  !(8)  -  .01  1  •  0  UTV  A  L  !<1>*  0  UTV  A  L  !<3> 

LET  LL  ■  8  :  L  E  T  UL  •  8  :60$UB  INTERP 

CALCULATE  BOX  9  (node  1111,  X  data)  ***** 

'  Recall  that  box  9  has  tw  o  d  i  f  f  e  r  e  n  t  n  odals,dependmg  on  w  h  e  th  e  r  boi 
'  7  (tin  f )  is  1  (10  n  ins)  or  2  (20  •  ms).  Note  that  in  the  latter  case 
'  the  n  odel  includes  a  range  tern  . 

IF  NoC  alcFlagX  (9  )  *  -1  THEN  GOTO  Next9 

IF  in  •  a  1  !(7)  ■  1  THEN  m»al!(9)»  .00  3  4  a  o«  tu  a  I  !(B)*  on  t*  a  )'(<)♦  .00  4  8  •  ou  t»  a  I  '<«)•  ou  tf  a  I  '(5)*  .00  1  8  •  o 
•  t  u  a  I !  (4)«  ou  t  v  a  I  !(4)  x  6  0  T  0  next9 

sn  a  i !  *  .10  0  0  1  :  s«  in  !  »  1  0  0  0  0  0  ! 

FOR  i  *  4  T  0  4 

IF  ovtval!(i))  sn  ax'THEN  sn  ax!*  oet«al!(i) 

IF  o  u  t  •  a  I !  ( i )  (  sn  in  f  T  HEN  sn  in!-  out»al!(i> 

NEXT  i 

IF  ou  t«  a  I  !(8)  )  sn  ax  !  T  HEN  sn  ax1-  oi»t*al!(8> 

IF  oit«al'(B)  (  sn  infTHEN  sn  in!  -  ou  tv  a  I  !(8) 

inn  a  I  !(9)  «  JO  9 1  •  0  u  tv  a  I  •<!)#  ou  t«  a  I  !(4>  ♦  .84  §  ou  tv  a  1 1  (3)  ♦  .21  •  on  tnaPM)  -  .38  *  (sn  ax '  -  sn  in  !) 


Next9  : 

IF  In  •  a  I  !(9)  )  95 ‘THEN  ineal!(9>«  95* 

LL  «  9  :  U  L-  9:  G0SU8  INTERP 

INV  A  L  !  (19  )  «  INV  A  L  !  (9)  :  LL- 1  9  ;UL«I9  :  6  0  S  U  8  INTERP 

'•••••••END  BOX  9  CALCULATIONS  ••••aa 

CALCN2: 

LET  LL  »  1  0  :  L  E  T  UL  »  1  4  :6QSU8  INTERP 

IF  NoC  ale  Flag*  (21 )  <)  -1  THEN  INV  A  L  !(2t  >  *  1  .83  *  OUTVAL!(10>*  OUTVA  L!(ll  )  ♦  .98  *A  8  $  (0UTV 
A  L  ! ( 1 0  )  -  OUTVA  L  !(11  )) 

IF  in«a  l!(20  )  )  9  0  !  T  H  EN  in v a  I !(20  >  »  9  0  ! 

IF  NoCalcFlagZ  (21  )  ()  -1  THEN  1NVAL‘(21)«  .28  •  OUTVA  L!<12 )  •  .134  *  0UTVAL'(13)»  OUTVA  L  '(1 

4) 

IF  in*  a  I !  (21  )  <  1  !T  HEN  in  v  a  1 1  (21  )  -  1  ! 

IF  INVAL'(13)-0'THEN  IF  N  oC  a  Ic  F  lagX  <2 1  )  ()  - 1  THEN  INVAL'<21>«  1 

IF  invar(13)()  O' THEN  in*  a  I!  (21  )  ■  ( in*  a  I!  <21  )  ♦  3)/ 3  'conv»rt0-9  seal*  to  1-4  scale 

IF  NoCalcFlagX  (2  2)-  -1  THEN  GOTO  KEEP  ON 

'As  s  un  e  HU  C  to  NCP  Void  is  there 

IF  INV  A  1!<U)  <  1  .5  T  HEN  IF  INV  A  L  *(19  )  (  20  THEN  INVAL!(22>-5  ♦  (1  .5*  INV  A  L  '<19  ))  ELSE  INVAL 
'(22  )  ■  35 
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IF  INVALMU  >  ■>  1  .5  T  H  EN  INV  A  L  !  (22  )  ■  2 1  ♦  <.3  *  INVAL'.<19  >) 

IF  INVAU<W>»>  2.5  THEN  INV  A  L  !  <22  )  *  2  2  ♦  (.4  •  INV  A.  .?)> 

KEEPON  : 

LET  LL  ■  17  :  L  E  T  UL  «  17  :GOSU0  INTER  P 

LET  LL  ■  20  :  L  E  T  U  L  *  2  2  x  6  0  S  U  B  INTERP 

IF  NoCalcFIagZ  <2  3)  <)  -  I  THEN  INV  A  L  .*<23  >  *  .4*  0  UT  V  A  L  !  <2t)  >  ♦  .00  3  2  •  0  UT  V  A  L  !  <21  >  ♦  .57»0UTVAL! 
(17)*  .21  •  0  UT  V  A  L  '<22  )  ♦  .21  •  on  t«  *!!<!!)  -  42! 

CALCN3: 

IN  V  A  L  !  <24  )  *  INV  A  L  !<20  )  :INVA  L  ‘<27)  «  INVAL  ‘<21  )  :  IN  V  A  L  1  <20  )  ■  INV  A  L  !<  17  )  :  IN  V  A  L  *  <31  >  «  INV  A  L  '<2 
3) 

LL  *  24  sOL  *31  :SO$U0  INTERP 
'*••••  CALCULATE  0  0*  32  RAW  SCORE  *aa»a 

IF  NoC  alcFIagZ  <32  )  <)  -1  THEN  INV  A  L  !  <32  )  -  .34  •  OUTV  A  L  ‘<24  )  ♦  1  .07  *  0  UT  V  A  L  !  <27  )  ♦  .11  *OUTVAL!< 
20)  ♦  .27  *  0  UT  V  A  L  !<3l  ) 

IF  in«  a  I!<32 )  <  I  ‘THEN  in* a  1!<32 )  ■  I  ! 

IF  in«  a  1 !  <32  )  )  I  10 ‘THEN  in  «  a  I !  <32  )  -  I  0  t  f 

C  A  LCfl  A  IN  : 

CALCI  I  I  : 

LET  L  L  *  3  3  sLET  UL  ■  35  :6OSU0  INTERP 
'•*•**  CALCULATE  00*  34  •••*• 

IF  NoC  ale  Flag*/ <3  4)  <)  -I  THEN  INV  A  L  !<34  )  «  <.02  1  >*  0  UT  V  A  L  '.<?)•  0  UT  V  A  L  !  <35  ) 

CA  LC 1 1 2  : 

LL  «  23  :  U  L  «  23  J6OSU0  INTERP 

imal!«n  »  ia«a!!<33>  :LET  LL  «  39  :LET  UL  «  3?  :GOSU0  INTERP 
'•••••  CALCULATE  0o*  40  •*••* 

IF  NoC  ale  Flag*  <4  0  )  <)  -1  THEN  INV  A  L  !  <40  )  *  .121  •  OUTV  A  L  !  <  23  )»0UTVA  L  •  <  39  )  'as  sum  p  112  sa»  p 

foro  as  1  1 1 

LET  LL  *  3  4  :L  ET  UL  «  34  :6OSU0  INTERP 
LET  LL  *  40:LET  UL  -  40  :SOSU0  INTERP 

•  •  •  CA  LCULATE  BOX  31  <nodp  II,  dplay) 

IF  NoCaUFlagX  <51  )  «  -I  GOTO  N5lNoCaIc  'OONE 
IF  0UTVAL*<34)  )  OUTVAL!<40)  THEN  0V!»0UTVAL!<34)ELSE  0  V  1  ■  0  UT  V  A  L  !<40  ) 

IF  OV  !  <  .4  T  H  EN  INVA  L!<51  )  ■  1  0  • 

IF  OV  •*)  .4  T  H  EN  INVA  L  ‘<51  )  ■  I  4  .4  - 1  I  *  0  V  * 

IF  OV.)  .7  THEN  INV  A  L  !<5!  )  »  7  .4  -  OV  ! 

LET  LL  -  31  :L  ET  UL  «  51  :  6  0  S  U  B  Intpr* 

N51  NoCalc  : 

'••***  CALCULATE  0OX  59  <n  od  p  1  ,  Z  u  am  p  d  in  tin  p  > 

IF  NoCalcFlagX  <39  >  *  -1  GOTO  N59NoCalc 

Coa  •  0  »  lay  ■  1  :  U  am0tlay»0UTVAL!<5l)  ♦  Cob  •  0  p  lay 
IF  U  amOtlay  <«  7  THEN  INVAL!<59)»  99 

IF  U  am  Op  lay  )  7  THEN  INVA  L  ‘<59  )  ■  9  9  -  4  9  »  <U  ar  n  0  a  la  y  -  7  )/3  0 
IF  U  arnO  pity  )  37  THEN  INVAL1  <59  >■  50 
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N5?NoCalc: 

C  A LC  2  3  2  : 

LL  *  3  2  :  U  L  *  32  :  G  0  S  U  8  INTERP 

i  ft  v  a  1 !  <  73  )  *  i  ft  v  4  1' (35  )  :  L  L  *  73  :UL  *  73  : 6  0  S  U  8  INTERP 

IF  NoC  a  lcF  lagX  (7  4)  ()  -1  THEN  IN  V  A  L  '<74  )  •  ( I  0  0 /5  4  >#  0  U  T  V  A  L  !  (32  >•  0  U  T  V  A  L  !  ( 73  ) 

'•••••••••BOX  4  4  (node  2  2  ,  E  A  «  dt  Ur  >•*••*  • 

'IF  NoCilcFUgZ  <44>*-l  60T  0  N4  AN  oC  4  le 
'  IF  0  U  T  V  A  L  !  <44  )  (  .4  THEN  INVAL'<44>»  21 

'IF  0UTVAL!<44)«)  .4  THEN  INVAL'<44>«  22.1  -  6  •  0  U  T  V  A  l  •  (44  ) 

'  IF  0  U  T  V  A  L  •  <44  )  )  .7  THEN  INVAL!<44>«  18.3 
N  4  4  N  oC  a  lc  : 

LL  -  7  4  :  U  L  »  7  4  :  6  0  S  U  8  INTERP 

IF  NoCalcFlagX  <85)0-1  THEN  IN  V  A  L  !  <85  >  *  5  2  .5  ♦  5  0  •  0  U  T  V  A  L '<74  )  'DONE 
CALC2  : 

LL  *  85:UL  •  85  :G0$U8  INTERP 

IF  NoCalcFUgZ  <8*  )<)-l  THEN  INV  A  L  \<U  )  *  1  0  0  •  0  UT  V  A  L  !<95  ) 

'EA  tt  e  Htc  tiviMSS  is  set  equal  to  E  A  ft  correctness  -  input  fro*  42  4nd  44  w  4  s  not  4  w  4  1 1  4  b  1  e  from 

d  4  t4 

C  A  L  C  0  : 

LL  »  5  9  :  U  L  «  5  9  :  G  0  S  U  8  INTERP 
LL  *  8  4  :  U  L  *  84  :  G  0  S  U  8  INTERP 

OUTVA  L  ‘<87  )*1  'Force  tt  an  a  g  e«  e  ft  t  is  set  to  1  0  0  X  tor  this  c  4  lc  u  I  a  1 1  on 

IF  NoC  alcF  lag/.  <8  8  >  <>  -1  THEN  INV  A  L  ‘<88  )  *  1  0  0  •  0  U  T  V  A  L  !<59  >•  0  U  T  V  A  L  1  <84  )•  0  L  T  V  A  L  1  <87  > 
CALCDONE: 

RETURN 

'eeeeeeeeeeeeeeeeeeeeeetnd  node  C4lc«4l4tionsi  »  •  *  •  *  »»  »  »  1 1 1  1 1  »  1  * 


'  ••••*•••••**•••••••  jftterpoUtion  m  ode  I 


INT  ERP  : 

F  0  R  J*  LL  T  0  UL 

IF  RV  !  <J,2>*0  0  R  IN  V  A  L  1  ( J)*R  V  '(J,l)  THEN  0  U  T  V  A  L  1  <  J)  *  S  C  !  <  J,1  > :  G  0  T  0  Neitlnterp 
IF  RV  !< J,2)  >  RV  '(J.DTHEN  InterpFUgM  ELSE  InterpFlag  *  -1 

IF  InterpFUgt  1NVAL  *<J)  <*  In  te  rp  F  L A  S  *  R V ’< J,1  >  THEN  OUTVAL'<J)«  S  C  !  <  J,1 ) :  G  0  T  0  Neitlnterp 
FOR  K  *  2  TO  4 

IF  RV  ’  <  J,K)  »  0  OR  RV  !<JfK)*RV  •  <  1  >  THEN  OUTV  A  L  !<J)  *  S  C  !<J,K-1  ):  G  0  7  0  Neitlnterp 

IF  InterpFUgi  1NV  A  L!<J>  <«  InttrpFUgt  RV  !<JfK>  THEN  0  U  T  V  A  L  1  <  J)  *  S  C  '  <  J.K-  1  )  ♦  <$C  ‘<  J.O-S  C 
!  <  J,K- 1  ))•  <  INV  A  L  '  <  J)-R  V  !<J,K-1  >)/<RV  '(J.XJ-RV  '  <  J,K-  1  >> ;  6  0  T  0  Neitlnterp 
NEXT  K 
Neitlnterp: 

N  EXT  J 
RETURN 


d  in  te  r p  0  la t  ion  •  0  do  1 
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HDUSEKEEP  ING 


HouseKeepmg:  'Startup  routines 


OEF  INT  A  -  2 

D  In  IN  V  A  L  f  (88  )  ,DU  TV  A  L  !  <  88  ),8N(8  8),FF*(88)  ,NN  f  (8  8  )  ,NA  f  (8  8  )  ,Uf1  ♦  (8  8  ) 

0  IM  P  <  8  8  ,4 ) ,  C (8  8  ,5),  S  <8  8  ,5),  SC  '<88  ,4),  R  V  *<88  ,6) , INV  A  LI  !(88  ) 

DIM  R  E  C  <2  0  ) :  D  IM  PP<2  5  0  0  ):OIM  N  o  C  a  Jc  F  I  a  g*/.  (8  8  ) 

XX  *  88:ParentNode  3  XX:$etectedNode  *  ParentNode:CHANGEFLAG  *  0 
0  a taS t tR e c or dS  n t  *  730 

pn  aa  I  %  3  STRINGS  (26  ,*  *)  :pn  a«  2*  3  S  T  R  IN  6  %  <2  6  • ) 

G  T I  *  *  )  *  :LT*  3  *  <  * 

T  \m  e  T  o  G  o  *  42  'set  this  u  a  1  u  e  so  that  counter  is  0  w  hen  d  e  H  1 1  e  loads 

8  D  XU  ID  E 3  9  5 

80XHI6H*53 

SPA  C  ING31  25 

PICTURE  ON 

CALL  PEN  S  I2E(I  ,1) 

CALL  M  DUET  0(0,0) 

CA  LL  L  IN  E  (0  .80XHIGH) 

CALL  L  IN  E  (8DXU  I0E  ,0) 

CALL  L  IN  E  (0  .-80XH  1GH  ) 

Call  l  in  e  (-9 oxu  ioe  ,o ) 

PICTURE  OFF 
8  OXI *3P IC  T  U  R  El 
P  ICTURE  ON 

CALL  P  EN  S  I?  E  (2  ,2) 

CALL  M  0  V  E  T  0  <0  ,0 ) 

CALL  L  IN  E  (0  ,8  0  X  H  1 6  H  ) 

CA  LL  L  IN  E  (8  0  X  U  IOE.O) 

CALL  L  IN  E  (0  , -8  0  X  H  IGH  ) 

CALL  L  IN  E  (-8DXU  IOE  ,0) 

PICTURE  OFF 
8  0  X  2  *  3  P  ICTURE* 

C  LS 

U  IN  0  OU  I  ,,<10  5  ,80  ) - ( 4  0  5  ,30  0  ),4 
CALL  T  EXT  $  12  E  <20  ) 

CALL  TEXTFACE(I) 

PMNT 

PUNT*  VANGUARO* 

P  ?  IN  T  *  ANA  LYSIS  SUPPORT  * 

PRINT'  TOOL* 

CALL  T  EXT  $  12  E  (1  4  );PR  IN  T 

PRINT*  Now  Loading  Tree  Definitions  ' :PR  IN  T 
P  R  IN  T  *  PLEA  SE  U  A  IT  • 


CALL  T  EX  T  5  12  E  (I  2  ) 

CALL  M  OV  ET  0  (  2  5  ,20  0  ) 

ON  T  1M  ER  <1  )  COSUB  T  i*  t  T  ab  le  ;  T  1M  ER  ON 
G  0  S  U  0  L  0  A  0  0  E  F 

TIMER  off 

U  IN  0  0  U  CLOSE  1 
GOSUB  C  rt  a  t  eM  e  n  u 
GOSU0  F  irs  t  S  c  rt  e  n 
RETURN 

T  i»  eTablt:  'Prouidts  countdow  n  w  hilt  tbt  definition  lilt  is  loading 

CALL  M  OV  ET  0  (25  ,20  0  >:T  im  eT  oGo  *  T  la  tToGo  -  1 
PR  INT  Mi*  t  to  go  is  *;Tim  tToGo;*seconds* 

RETURN 

LOAOOtF:  'Load  t  h  t  definition  file  OEFFILE  into  •  e »  or  y 

OPEN  *R  * ,  1  ,*OE  FF  ILE  * 

FIELD  I  ,  2  A  S  A  ♦  ,  1  AS  A  A  S  ,  6  A  S  B  S  ,  30  AS  Ct  ,  1  AS  Ot(6  AS  1%  ,  1  9  AS  Ft,!)  AS  0  S  ,  ?  4  AS  HS 
,24  AS  It,  12  AS  RESTS 
F  0  R  1  *  1  T  0  XX 
GET  1,1 

BN  (I)  *  C  V  I(AS):FFs(D*  A  AS:NNS(I)  *  BS:NA$(I)  =  CS  :UM  S  I)  =  Ds 
FOR  J  *  1  TO  4  :  X  *  (Jt  2  >-  1  :  P  (1  ,J)  «  C  V  KM  10  t  (Et  ,K  ,2>>:N  E  X  T  J 
FDR  J  *  1  TO  5  :  X  »  ( J  •  2  >- 1  ;  C  <I,J)  *  C  V  1  (M  I  0  i  (Fs  ,X  ,2  ) ) :  N  E  X  T  J 

FOR  J  *  l  TO  5  :  K  *  ( J»  2  >- 1  :  S  <  I  ,J>  *  C  V  1  (M  ID  S  (Gs  ,K  ,2)):N  E  X  T  J 

FDR  J  *  I  TO  6  :  X  *  <J»  4  )-3  :  SC  MI,J)*  C  V  S  <M  ID  S  (MS  ,X  ,4)):N  EX  T  J 

FOR  j  *  1  TO  6  :X  =  (J»  4  )-3  :  RV  !(1,J)«  C  V  S  (M  ID  s  (is  ,X  ,4  )):N  EX  T  J 

N  EXT  I 
CLOSE 

0  P  EN  *R\2/OATAFILE\?30 
FIELD  2,26  AS  OA  S ,  7  0  4  AS  DBS 
Nui  berOfDataSets*LOF<2>/733 
M  axP  age  s*/.  *1  ♦  IN  T  <<Num  berOfDataSets-l)/l0) 

NUMS  *  ST  3  S  (N  u  •  berOfDataSets) 

Nu*  ber£ntered*Nui»  berOfDataSets 

OPEN  *R  *  ,3  ,  *  INO  E  X  F  1L  E  *  ,6 
F  IELO  3  ,  6  A  S  IXS 

OPEN  ’R  *,  M  ,  *VA  ST  O  i  s  K  2  :TE  XT  F  IL  E  #  ,P0  0 
FIELD  14,700  AS  T  x  tA  S 

'  Notf  that  Box  9  (Node  1111  )  his  children  box  4,bo*  5, box  6  and  bo*  8. 

'  The  m  odfl  tor  this  node  differs  dtpending  on  w  htther  bo*  7  (tim  e) 

'  is  equal  to  1  (10  o  ms)or  2  (20  m  ms).  The  follow  mg  arrays  ho>3  tw  o  se's 
'of  scale  values  for  use  in  calculating  box  9  . 


28 


Din  S4'<2,4)  .-DATA  5  9  .3A  ,  7  5  .77  ,  8  2  .15  ,  8  6  .<7  ,  1  3  .94  ,  4  2  .1  7  ,  6  3  .60  ,  I  0  2  .87 

D  in  $5  '(2,4)  :D  A  T  a  3  6  .4?  ,  7  8  .70  ,  8  6  .24  ,  1  0  <  .51  ,  2  1  .23  ,  5  3  .1  3  ,  5  8  .57  ,  9  0  .46 

D  in  S  6  1  (2,4 )  :  0  A  T  A  4  2  .1  3  ,  8  0  .00  ,  1  1  8  .95  ,  0  .0,  1  6  .35  ,  2  1  .82  ,  1  2  6  .90  ,  0  .0 

D  in  S  8  M2.4)  :  D  A  T  A  2  0  .0  7  ,  9  I  .1  3  .  9  7  .34  ,1  0  4  .6,1  3  .9,1  6  .02  ,  6  3  .89  ,8  2  .54 


'load  the  •*  o  sets  of  scale  values  for  calculating  so*  9. 

FOR  i  *  1  TC  2  :  F  0  R  j  =  1  TO  4  :  R  E  A  0  S«!(i,j):NEXT  j  :  N  E  X  T 

FOR  .  *  1  TC  2  :  F  0  R  j  *  1  TO  4  :  R  £  A  D  $  5  *< i ,  j>  :N  E  X  T  j  :  N  E  X  T  i 

FOR  i  =  1  TO  2  -.FOR  j  *  1  TC  4  .-READ  S6  Mi,j>:N  EXT  j  :  N  EXT  i 

FOR  t  *  l  TO  2  :  F  O  R  j  *  1  TO  4  -.READ  S  8 'd  ,  j) :  N  £  X  T  j  :  N  E  X  T  i 

8  1  a  n  I  S  tr  m  gS  *  S  T  R  IN  G  *  (4  5  0  ,*  *) 

'The  follow  mg  loads  the  bo*  nja  bers  of  the  nodes  that  actually  enter 
'into  the  calculation,  either  as  a  p  r  in  itive  or  a  calculated  value. 

Oin  R  e  a  18  o  *  (3  7  ) 

DATA  1  ,3,4  ,5,6, 7,8  ,9,1  0  ,1  1  ,12  ,13  ,1  4  ,1  6  ,17  ,18  ,19  ,20 

DATA  2  1  ,22  ,23  ,26  ,27  ,28  ,3  1  ,32  ,3  5  ,36  ,3  9  ,4  0  ,5 1  ,5  9  ,73  ,7  4  ,8  5  ,8  6  ,8  8 

FOR  i  «  1  TO  37  :  R  E  A  D  Real8o*(i):NEXT  i 

RETURN 

^•lemimiiMMiniHd  Startup  Roitnes*  m  m  i  i  i  m  i  m  m  e  •  e  e  e  e 


C  re  a  tefl  et  i  : 

MENU  l  ,0,1  ,*He  Ip * 

MENU  1,1,1  ,Mnfor«  a  t  ion  ' 
n  EN  U  2  ,0 ,1  ,*Oa  ta  ’ 

MENU  2  ,1  ,1  ,*En  ttf  N  py  Capabilities* 

MENU  2,2,1, 'Retrieve  EiistmgData* 

MENU  2  ,3,1  ,'Sh  ow  Oata  Sets' 
nENU  3  ,0  ,1  ,  'S  p  e  c  i  a  l  F  u  n  c  t  ion  s  * 
nENU  3  , 1  ,1  ,*S  e  n  s  1 1 1  v  i  ty  A  n  a )  y  s  i  s  ' 

MENU  3, 2,1, 'Co*  pare  Data  Sets’ 

M  ENU  3, 3,1, 'Set  M  in  in  u  m  Range  Values* 

HENU  3  ,4  ,1  ,#Pf  in  t  screen’ 
nENU  4  ,0  ,|  ,'EXIT  * 
nENU  4  ,  l  ,  l  ,  *£n  C  Y  A  S  T  Session 
nENU  5,0,0,' 

ON  nENU  S0SU9  etenuchec*  'n  eiiu  is  not  turned  on  here 

RETURN 


*  enuchec*:  closed  loops  for  pern  anentlr  active  m  enus 

a  enunum  D  e  r  *  n  ENU(0):  n  enuten  *  1  E  N  U  ( 1  ) 

IF  m  enunun  5  e  r  *  2  AND  n  enuitem  =  4  THEN  GDSU8  screencopr 
IF  n  enuflun  5er  =4  AND  m  en^iten  =1  THEN  GOTO  e*itr«  enu 
RETURN 
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F  irs tS  crt  t  ft  : 


U  IN  D  0  U 

2  ,,(10  5,1  0  0  )-<  4  0  5  ,30  0  ),2 

CIS  :  C  ft  L  L  T  EXT  S  III  <2#  )  :C  ft  LL  TEXTFftCE(l) 

PRINT 

PRINT  * 

V ANGUA  R  D  * 

P  R  IN  T  * 

ANALYSTS  SUPPORT1 

P  R  IN  T  • 

TOOL* 

PRINT  :  P  R  1 N  T  *  (Pull  Dow  n  i  N  t  nu  )’ 

RETURN 

:w 


Program  Name: 

Modify  DEFILE 

Language : 

BASIC 

Machine : 

Apple  Macintosh 

Purpose : 

This  program  is  a  utility  to  support  the  VAST  program. 

VAST  reads  a  definition  file  which  contains  all  data 
relevant  to  the  hierarchical  mission  structure  embedded  in 
VAST.  This  program  allows  the  user  to  modify  data  about 
any  node  in  the  hierarchy. 
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REM  Modify  DEFFILE 

REM  This  program  enters  node  data  into  DEFFILE 
DEFINT  A-Z 

cleerj  -  STRING$(I20,*  *) 

OPEN  -R’,  I /DEFFILE* 

FIELD  I,  2  AS  A$,  1  AS  AAJ,  6  AS  BJ,  30  AS  CJ,  I  AS  D$,  8  AS  EJ,  10  AS  FJ,  10  AS  GJ,  24  AS  HI. 
24  AS  IJ,  12  ASDUJ 
CLS 

CLEARALL 

FF$  ■  **:  NNJ  -  NAJ  -  **:  UMJ  -  PJ  -  **:  CHJ  -  **:  SCI  •  **  RVJ  -  **:  SJ  -  " 

FOR  I  -  I  TO  6 

P(l)  -  0;  C(l)  -  0.  5(1)  -  0:  SCKI)  -  0:  RVKI)  -  0 
NEXT  I 

WINDOW  I „( 1 ,20)-(490,340),2 
CLS 

PRINT*  I  ENTER  DATA  FOR  ALL  NODES* 

PRINT:  PRINT:  PRINT  *2  EDIT  DATA  FOR  A  SPECIFIC  NOOE* 

PRINT:  PRINT:  PRINT *3  EXIT  PROGRAM- 

PRINT:  PRINT  INPUT  'ENTER  THE  NUMBER  OF  YOUR  CHOICE*, CHOICE 
IF  CHOICE  <  I  OR  CHOICE  >  3  THEN  GOTO  CLEARALL 
ON  CHOICE  GOSUB  ENTERALL,  EDITONE,  ENDIT 
CLS  GOTO  CLEARALL 


ENDIT. 

CLS 

CLOSE 

WINDOW  CLOSE  I 
END 

ENTERALL: 

INPUT  ‘ENTER  THE  BOX  NUMBER  OF  THIS  NOOE  OR  0  TO  END  *,BN 

IF  BN  -  0  THEN  CLOSE  RETURN 

INPUT  'ENTER  THE  FUNCTION  CODE  OF  THE  NOOE  \FFJ 

INPUT  'ENTER  THE  NOOE  NUMBER  \NNJ 

INPUT  ‘ENTER  THE  NOOE  NAME  *,NAJ 

INPUT  ‘ENTER  THE  NOOE  UNIT  OF  MEASURE  *,UMJ 

FOR  I  -  I  TO  4 

PRINT  ‘ENTER  THE  BOX  NUMBER  OF  PARENT  *1, 

INPUT  P(l) 

NEXT  I 

FOR  I  -  I  TO  S 

PRINT  ‘ENTER  THE  BOX  NUMBER  OF  CHILD  NUMBER  *1; 

INPUT  C(l) 

NEXT  I 

FOR  I  *  I  TO  5 


PRINT  ‘ENTER  THE  BOX  NUMBER  OF  SIBLING  NUMBER ‘I; 

INPUT  S(l) 

NEXT  I 

FOR  I  -  I  TO  6 

PRINT  ‘ENTER  THE  RANGE  VALUE  FOR  LEVEL  ‘I  ‘OF  THIS  NODE', 

INPUT  RVKI) 

NEXT  I 

FOR  I  -  I  TO  6 

PRINT  ‘ENTER  THE  SCALE  VALUE  FOR  LEVEL  ‘I  ‘OF  THIS  NODE  *; 

INPUT  SCKI) 

NEXT  I 
PUT  IT: 

LSET  Aj  -MKIJ  (BN) 

LSET  AAj  -  FFJ 
LSET  BJ  ■  NNJ 
LSET  CJ  -  NAJ 
LSET  DJ  - UMJ 
FOR  I  -  I  TO  4 
PJ  -  PJ  ♦  MKIJ(PO)) 

NEXT  I 

LSET  EJ  -  PJ 

FOR  I  -  I  TO  5 

CHJ  -  CHJ  ‘  MKIJ(C(D) 

NEXT  I 

LSET  FJ  -  CHJ 
FOR  I  -  I  TO  5 
SJ  •  SJ  4  MKl  J(S(0) 

NEXT  I 

LSET  GJ  ■  SJ 

FOR  I  -  I  TO  6 

SCJ  -SCJ  4MKSJ(SCKI)) 

NEXT  I 

LSET  HJ  -  SCJ 
FOR  I  -  I  TO  6 
RVJ  -  RVJ4  MKSJ(RVKD) 

NEXT  I 

LSET  IJ  -  RVJ 
PUT  I.BN 
CLS 

RETURN  REM  goto  clears  1 1  changed  to  return  12  may 

EDI  TONE 
CLS 

INPUT  ‘ENTER  THE  BOX  NUMBER  OF  THE  NODE  TO  EDIT  OR  0  TO  END* .BOX 
IF  BOX-O  THEN  RETURN 

IF  BOX  <  I  OR  BOX  >  88  THEN  PRINT  ‘INVALID  BOX  NUMBER  -  TRY  AGAIN':  FOR  TL  -  I  TO  IOOO:  NE 
XT  TL  GOTO  EDITONF 
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GET  I  .BOX 

BN  ■  CVKAJT  FFJ  ■  AAS  NNJ  -  BJ:  NAJ  -  CJ  UMJ  -  DJ 
FOR  J  -  I  TO  4  K  -  (J*2)- 1:  P(J)  -  CVI(MIDJ(EJ,K,2)):  NEXT  J 
FOR  J  -  I  TO  5.  K  -  (J*2)-  I:  C(J)  -  CVI(MIDJ(FJ.K,2))  NEXT  J 
FOR  J  -  I  TO  S:K-(J*2)-I:S(J)-CVI(MIDJ(GJ,K,2))-  NEXT  J 
FOR  J  -  I  TO  6:  K  -  (J*4)-3:  SC!(J)  •  CV5(MIDJ(HJ.K,4)>.  NEXT  J 
FOR  J  -  I  TO  6:  K  -  (J*4)-3:  RVKJ)  -  CVS(MIDJ(IJ.K,4)):  NEXT  J 
CLS 
show  It: 

CALL  TEXTFACE  ( I >.  PRINT  *  0  NODE  NUMBER  *;:  CALL  TEXTFACE  (Oh  PRINT  NNj,TAB(SO).*this 
Is  BOX  ';BOX 

CALL  TEXTFACE  (I  >.  PRINT  *1  NODE  NAME  CALL  TEXTFACE  (0):  PRINT  NAJ 
CALL  TEXTFACE  (lh  PRINT  "2  NODE  FUNCTION  *,:  CALL  TEXTFACE  (Oh.  PRINT  FFJ 
CALL  TEXTFACE  ( I  h  PRINT  *3  UNIT  OF  MEASURE  *;:  CALL  TEXTFACE  (Oh  PRINT  UMJ 
CALL  TEXTFACEOh  PRINT  *4  PARENTS  *:  CALL  TEXTFACE(O) 

FOR  I  -  I  TO  4.  PRINT  P(l),:  NEXT  I:  PRINT 

CALL  TEXTFACE(I)  PRINT  "S  CHILDREN  *  CALL  TEXTFACE(O) 

FOR  I  -  I  TO  S-  PRINT  C(l),  NEXT  I:  PRINT 

CALL  TEXTFACEOh  PRINT ‘6  SIBLINGS  CALL  TEXTFACE(O) 

FOR  I  -  I  TO  S-  PRINT  SO),:  NEXT  I.  PRINT 

CALL  TEXTFACEOh  PRINT  *7  RANGE  VALUES  *:  CALL  TEXTFACE(O) 

FOR  I  -  I  TO  6:  PRINT  RVKI),  NEXT  I:  PRINT 

CALL  TEXTFACEOh  PRINT  ‘8  SCALE  VALUES  *  CALL  TEXTFACE(O) 

FOR  I  -  I  TO  6-  PRINT  SCKl),  NEXT  I  PRINT 

PRINT:  PRINT 

vp  -  CSRLIN:  hp  -  POS(O) 

PRINT  "ENTER  THE  NUMBER  ASSOCIATED  WITH  THE  FIELD  YOU  WANT  TO  CHANGE  * 

PRINT  "ENTER -I  TO  ESCAPE*  REM  exit  option  Inserted  12may 

WHICHON: 

INPUT  WHICHONE 

IF  WHICHONE  <0  THEN  RETURN  REM  exit  option  Inserted  1 2  may 

IF  WHICHONE  <0  OR  WHICHONE>  8  THEN  PRINT'INV ALIO  CHOICE  -  TRY  AGAIN*  FOR  TL  -  I  TO  1000 
a.  NEXT  TL:  GOTO  WHICHON 
LOCATE  vp.hp:  PRINT  cleerj 
LOCATE  vp.hp 

IF  whichone  -  0  THEN  INPUT  "Enter  the  new  node  number  ",nnj 
IF  whichone  -  I  THEN  INPUT  "Enter  the  new  name  of  the  node  ",naj 
IF  whichone  -  2  THEN  INPUT  "Enter  the  new  function  code";  ff  J 
IF  whichone  -  3  THEN  INPUT  "Enter  the  new  unit  of  measure",  umj 

IF  whichone  -  4  THEN  FOR  I  -  1  TO  4:  PRINT  "Enter  the  number  of  the  box  for  parent  "i;  INPUT  p 
(I):  NEXT  I 

IF  whichone  -  S  THEN  FOR  I  -  I  TO  S:  PRINT  "Enter  the  number  of  the  box  for  child  ",  INPUT  c(i) 

:  NEXT  i 

IF  whichone  •  6  THEN  FOR  I  -  I  TO  S  PRINT  "Enter  the  number  of  the  box  for  sibling  ",  INPUT  s( 
Ih  NEXT  I 

IF  whichone  -  7  THEN  FOR  i  -  I  TO  6.  PRINT  "Enter  the  number  of  thp  hoy  for  "  •  *jr>" 
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T  rvKi):  NEXT  1 

IF  whichone  -  8  THEN  FOR  I  •  I  TO  6:  PRINT  'Enter  the  number  of  the  box  for  scale  value  INPU 
T  scKi):  NEXT  i 

checkok. 

INPUT  'Is  the  data  for  this  node  correct  ',yn$ 

IF  ynS  -  y  OR  ynS  -  'V  THEN  BN  -  BOX  :  GOTO  PUTIT 
CLS 

GOTO  showlt 


Program  Name: 


Load  Text 


Language : 
Machine : 
Purpose : 


BASIC 

Apple  Macintosh 

This  program  is  a  utility  which  supports  the  VAST  program. 
The  VAST  program  allows  the  user  to  view  information  about 
any  node  in  the  tree.  That  information  is  loaded  into  a 
file  using  this  program. 


'  This  Program  enters  definition  data  Into  text  file 

GOSUB  Housekeeping 
GOSUB  GetCholce 

ON  Choice  GOSUB  ENTERNEW,  EdltOne,  EnterOefauits,  PrlntAII 
GOSUB  EndOf  Job 


Housekeeping 
DEFINT  A-Z 

OPEN  *R\  *  I, "VAST  Disk  IDEFFILE" 

FIELD  *1.  2  AS  AS,  I  AS  BJ,  6  AS  CJ,  30  AS  DJ.  89  AS  EJ 
OPEN  ‘R‘,  *2, "VAST  Disk  2:TEXTFILE\900 
FIELD  m7,  900  AS  FJ 
CLS 

RETURN 


GetCholce: 

PRINT  ‘  I  ENTER  DATA  FOR  A  SPECIFIC  NODE' 

PRINT:  PRINT  "2  EDIT  DATA  FOR  A  SPECIFIC  N00£‘ 

PRINT  PRINT  ‘3  Enter  All  Defaults* 

PRINT-  PRINT  ‘4  Print  all  NonDefault  Entries' 

PRINT:  PRINT:  INPUT  ‘ENTER  THE  NUMBER  Of  YOUR  CH0ICE*,CH0ICE 

’IF  CHOICE  <>  I  AND  CHOICE  <>  2  AND  CHOICE  <>  3  AND  CHOICE  <>  4  THEN  GOTO  GetCholce 

IF  CHOICE  <>  I  AND  CHOICE  <>  2  AND  CHOICE  <>  4  THEN  GOTO  GetCholce 

RETURN 


ENTERNEW: 

WHILE  I  -  1 
CLS 

INPUT  ‘ENTER  THE  BOX  NUMBER  OF  THE  NOOE  TO  Enter  OR  X  TO  END‘;BOX$ 

IF  BOXj  -  ‘X‘  THEN  RETURN 
J  -  VAL(BOXj) 

IF  J  <  I  OR  J  >88  THEN  PRINT  ‘INVALID  BOX  NUMBER  -  TRY  AGAIN"  FOR  TL  -  I  TO  1000  NEXT  T 
L:  GOTO  EDITONE 

FFJ  -  STRINGJ(900,‘  ‘) 

GET  *I.J 
NodenumJ  *  CJ 
NodenameJ  *  DS 

PRINT  ‘THE  NODE  NUMBER  Is'.NodeNumJ 
PRINT  ‘  THE  NODE  NAME  Is  ‘.NodeNameJ 


PRINT  ’Enter  12  lines  of  definition’ 

FOR  I  •  I  TO  12 
Strt  -  (I  -  I  )*75  ♦  I 
PRINT  STRJ(I); :  INPUT  * *, textS 

IF  LEN(textS)  >  75  THEN  Ingth  -  75  ELSE  Ingth  -  LEN(textJ) 
MID$(FFS, strt, Ingth)  -  texts 
NEXT  I 

LSET  FS  -  FFS 
PUT  *2J 

J  *  J  *  ' 

WEND 

RETURN 


Ed  I  tone: 

WHILE  I  -  I 
CLS 

INPUT  ’ENTER  THE  BOX  NUMBER  OF  THE  NOOE  TO  EDIT  OR  X  TO  END’.BOXJ 
IF  BOXJ-’X’  THEN  RETURN 
J  -  VAL(BOXJ) 

IF  J  <  I  OR  J  >  88  THEN  PRINT  ’INVALID  BOX  NUMBER  -  TRY  AGAIN’:  FOR  TL  -  I  TO  IOOO  NEXT  T 
L  GOTO  EDITONE 
GET  »l.j 
NodenumS  -  CS 
NodenameS  -  DS 
CALL  MOVETO  (10,30) 

PRINT  ’THE  NODE  NUMBER  is  ’;NodeNumJ 
PRINT  ’  THE  NODE  NAME  Is  ’,NodeNameS 
GET  *2,J 
FFS  -  FS 

FOR  I  -  I  TO  12 

Strt  -  (I  -  l)*75  ♦  I 

PRINT  STRJ(I),’  ’,MIDJ(FFJ,strt,75) 

NEXT  I 
Getllne: 

PRINT 

INPUT  ’What  line  to  change  (full  stop  (.)  to  qult)’;NumJ 
IF  NumJ  -  ’.’  THEN  GOTO  Check  It 
llnenum  -  VAL(Numi) 

Strt  -  (llnenum  -  I  )*75  ♦  I 
INPUT  ’Enter  new  text’,  texts 

IF  LEN(textS)  >  75  THEN  Ingth  -  75  ELSE  Ingth  -  LEN(textS) 

M l DS (FFJ.strt, Ingth)  -  texts 
Check  It: 

CALL  MOVETO  (10,30) 

PRINT  ’THE  NODE  NUMBER  is’.NodeNumS 
PRINT  ’  THE  NODE  NAME  is  ’.NodeNameS 
FOR  I  -  I  TO  12 
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Strt  -  (I  -  1  >*7S  ♦  I 
PRINT  STRJ(I);'  ',MIDJ(FFJ,strt,75) 
NEXT  I 

INPUT  'Is  this  Correct  (Y/N)';  yesnoJ 
IF  yesnoJ  ■  "n*  THEN  GOTO  getllne 
L5ET  FJ  ■  FFJ 
PUT  '2,j 
WEND 
RETURN 


EnterOe  faults: 

FOR  I  ■  I  TO  88 

FFJ  -  STRINGJ<900,' ') 

GET  'I,  I 

textj  -  'Node  Name:  '  ♦  DJ 
MIDI  (FFJ,  1,75)  ■  Textj 

textj  -  "The  definition  of  box  '♦  STRJ(I)  ♦ '  has  not  been  entered.' 
MIDJ  (FFJ,  76,75)  ■  Textj 

textj  -  'The  value  of  this  node  does  not  Impact  the  final  ' 

MIDJ  (FFJ,  151,75)  ■  Textj 

textj  -  ‘result  at  Node  0.  Intermediate  results  may  or  ' 

MIDJ  (FFJ,  226,75)  -  Textj 

textj  ■  'may  not  reflect  actual  relationships  derived  ' 

MIDJ  (FFJ, 301, 75)  -  Textj 
textj  -  ‘  from  data  collection.' 

MIDJ  <FFJ,376,75)  -  Textj 
MIDJ(FFJ,45I,450)  -  STRINGJ(450,'  ') 

L5ET  FJ  -  FFJ 
PUT  '2,  I 
NEXT  I 
RETURN 


Print  A1 1. 

BtextJ  -  STRINGJ(75,' ') 

FOR  J  -  I  TO  88 
GET  '!,]  •  GET  '2,J 
NodenumJ  -  CJ 
NodenarneJ  -  DJ 
LPRINT  LPRINT 

LPRINT  'THE  NOOE  NUMBER  Is '.NodeNumJ 
LPRINT  '  THE  NODE  NAME  Is  '.NodeNameJ 
FFJ  -  FJ 

IF  MIDJ(FF J.76,2 1 )  -  'The  definition  of  box'  THEN  GOTO  NexJ 
FOR  I  -  I  TO  12 
Strt  =  (i- 1  )*75  •  I 
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texts  *  MIDS(FFS.Strt.75) 

IF  texts  -  BtextS  THEN  GOTO  nexl 
LPRINT  texts 
nexl:  NEXT  I 
NexJ:  NEXT  J 
RETURN 


EndOfJob: 
CLS 
CLOSE 
'  SYSTEM 
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Program  Name: 

Prepross 

Language : 

FORTRAN 

Machine : 

VAX  11/750 

Purpose : 

This  program  is  a  utility  to  support  the  data  reduction 
effort.  It  reads  data  from  questionnaires,  computes 
average  responses,  and  produces  a  file  that  the  program 
STF  can  read . 
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DIMENSION  lEV(5).:«(S)tIC<7>.0  57(6.6.*.6.£).CMT<6.«.6.-*.*> 
DIMENSION  CATi<:s),OAT2<eO)*CAT\(3CO) 

CMJRJCTE5i‘  IC 

CHA5ACTE  R$E  ! NCC  ,  INOI <  25 ) . I NC2< 1 2  5 )  ,  INCNC  300) 

CHARACTERED  I*Il,?FIL 
ChaRACTE  R*40  I  T  :  T 

C  CPEN(UNn  =  l2.KAMe*'OUT.0AT*,TTPE*'\EX') 

WRITEC5.90C) 

900  FCRMATC IX, 'Enter  FH®N*.re:  *,1) 

S£AQ(5,901 )NC  ,  IF  IL 

901  FCRMAT(C,A) 

WRITEC  5.902  ) 

902  F0RHATC1X* 'Enttr  40  ch<r.  Title:  *,S) 

REAQ( 5. 901 )NT  ,  IT  I  T 

GPEN(UMT*10»NAKE*IFlLtTTPE**CLC*) 

PFIL  =  IFILC1  :nC)  //  #  S  T  F  ' 

CPEN(UNIT*11,NAKE*PFIL.TTPE«'NE-') 

WRITECU  ,9C9)ITIT 
909  FQRMAT(AAO) 

R£A0(10»903)NF 

903  FORMAT(I) 

WRITEC  II  ,9C4)NF 

904  FQRMATC5I4) 

REA0(10*905)(LEV(I),I*1*NF) 

905  FORMAT (511) 

WRITECIl»9C4>(L£V(I),I«ltNF) 

10  continue 

REAO(10.90£.ENC*20)IQ,IR,IC,IC 

906  F0RMATC13I1 , A) 

X  C  *  U  M  A  T C IC) 

I*IOCI)M 

J*I0C2)M 

ft>I0(3)M 

1*10(4)41 

M»I0( 5)4  l 

0AT(IfJtK,L,M)*CAT(ItJfKtL,M)4XC 
CNT( I  *  J  »  K  »  L  »M)*CNT( I#J#X»L»M)4l  .0 
GO  TO  10 
20  CONTINUE 

CLOSECUNIT* 10) 

00  30  1*  1  9  t 
00  30  J* 1 , i 
00  30  K*  1  ft 

00  30  L*  1  ft 

00  30  M*  l 

IF(CNT(I»J»K,l<^).EC«0.0)GC  to  30 

OAT(I  t  J ♦ F  •  L  »M)*CAT<  I  «  J  t  K  » l  #M)/CNT(I  ,  J  .  '  ,  L  *  -  ) 

30  CONTINUE 

oo  40  r= i tt 

00  40  L*1 
CO  40  *  =  1 
CC  40  J  =  1  »  E 
OC  40  1=1,6 

IFCCNTCI  ,  J,K,L  ,k).EC.O.Q)GC  TO  <•  0 
IK*0 

IF(  I  .GT  .  1)IK *IK4  1 
I  F( J  .GT . 1 ) IK* I «  «  1 

IF(K.GT.1)IK*IK41 
IP(L«GT,1)IK*Ik«1 
IFCM.GT  .DUMMl 
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lN:x*(I-l)sl00CO(J-l>fl00C*(<-l>$100*(t-l)ai0«(V-l> 
ENCCCE(6,910. isco>:snx 
910  FORHATCI5. #0*) 

OC  45  11*1,6 

iccinocci::ii).ec.'  #>  inooc  :  i :  i : >  =  ’0  • 

45  continue 

GO  TO  c  50, 40, 70  •  70, 70) , I* 

50  CONTINUE 
N 1 *N  1  ♦  1 

0  AT  1  <N  1  )*0A  T  (  I  ,  J  ,  *  ,  L  ,  *<  ) 

IN0KN1  )*IK00 
GC  TO  40 
60  CONTINUE 
N2*N2*1 

0AT2(N2)*9*T(I,J,*,l.M) 
iri02CN2)»INOO 
GO  TC  40 
70  CONTINUE 

N  N  *  N  N  ♦  1 

OATN(NN)*QAT (I i JfKiltH) 

IN0N(NN)*IN00 
40  CONTINUE 

WRITEC1 1  •  9C 9 ) N 1 
909  FQRMAT(I4) 

00  90  1*1* M 

URITE(11,9C7)INC1(I),0AT1(I) 

907  F0RMAT(A6,F8.3) 

90  CONTINUE 

wRITECll  ,9C8)N2 
00  1  00  1  =  1  , N2 

WRITEC11  ,9C7)In02(I),OAT2<I) 

100  CONTINUE 

WRIT6C1 1 , 9 C  8 ) N N 
00  110  1*1, NN 

wRITECll »9C7)INCN(I),QATN(I) 

110  CONTINUE 

CLCSECUNIT* 11) 

CALL  EXIT 
ENC 

FUNCTION  W  h  A  T ( IC) 

CHARACTER**  IC 
L0GICAL51  SWITCH 
INTEGERS  PLACE 
REALS4  NUM,RINTK 
SWITCH  *  .  F ALSE  . 

NUH=  0 . 0 
00  1  1*1,4 

IF( ICC  I : I ) . EC  .  *  .  ') GC  TC  3 
IFC ICC  I :  I  ) . EC.  '  * )GC  TC  2 

0EC00EC1,9C0,ICCI:I));nT« 

900  c:r^atcii) 

R  I N  T  M  -  I  N  T  M 

IF  ( SWI TCH. EC. .  T  RUc .  )  ThEN 

nun  =  MV  ♦  :iMTHdC10-0««pL4Cs) 

PLACE  =  PLACE  -  1 
ELSE 

NUH  =  NUm  -  1  0  ♦  R  !  NT*4 
ENC  IF 
1  CONTINUE 
3  SWITCH  =  .T^UE. 


PLACE  =  -1 
GO  TO  1 
2  CONTINUE 
WHAT  * N U H 
RETURN 
ENC 
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Program  Name: 

STF 

Language : 

FORTRAN 

Machine : 

VAX  11/750 

Purpose : 

This  program  does  the  data  reduction.  The  user  can  specify 
the  form  of  the  model  and  initial  scale  values;  the  program 
produces  the  optimal  set  of  weights  and  calculates  the 
CHI-SQUARE  value. 

STF  calls  the  following  subroutines; 

SDM  -  Select  Data  Module 

SSV  -  Set  Scale  Values 

SRV  -  Select  Regression  Variables 

RUN  -  Compute  Optimal  Chi-Square 

RES  -  Display  Results 
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c 


c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 


SUBJECTIVE  TRANSFER  PUKCTICN  --  STF  --  MAIN  CQLTINE 


CALLS:  S^O 

SSV 
SR  v 
nLN 
»ES 


SELECT  0  A  T  A  vCCEL 
SET  SCALE  VALUES 
SELECT  REGRESSION  VARIABLES 
RUN  AN  ITERATICN 
0  I  S  0  L  A  t  RESLLTS 


COHMQN 

common 

common 

COMMON 

Common 

Common 


/UNITS/  hVlO,NMO.LLNl*IOCtlNFIL 

/ P  ARAM/  NE#Nl,N2fNNfNVtNW#MPtML,NP,LEV(8)*FACTa(S) 
/FLAGS/  KOFLG.N2FLG.NNFLG 

/RAW/  0AT1(30)*CaT2(250)*CAT(3C0),S(B,5), X  S  C  (  8  *  5  ) » 
IC1(30,6)*IC2(250»6)»I3(300»6)»T(3»5) 

/RECR/  TC2SC)«CC2SO«27).uC27).XSVC273»CHXSO.PCHXSC 
/RUN  RES/  NITER, NSTEPS.NSAO.MSTEPS.SSZE 


CHARACTER^  ANS*FACTR 
CHAR  ACTEQSO  inf  il 


OATA  MF.ML  »L UN  1/8*5*10/ 

DATA  FaCTR/#A#,  '&'*  '  C  '  *  *0'*  '  E  '  *  '  F  #  ,  *0 ' .  ' R  '/ 


INITIALIZE 


NOFLG*0 
N  2  F  L  G  *  0 
NNFLG*0 
N  E  *  0 
N  1  *0 
N  2  *  0 
NN*  0 
N  V*  0 

n  w  *  o 

N  F  *  0 

00  12  I  *  1  »  M  F 
LEVC I )«0 
12  CONTINLE 


INITIALIZE  "SCREEN  MANAGEMENT  GUIDELINES” 

CALL  SMGICREATE.PASTEBCAROCNPIO) 

CALL  SMGSCREATE^VIRTUAL_0:SPLAY(24,a0,NVI0) 
CALL  SMGSPASTE.V IRTUAL.OI SPLAY (NV IC . NPIP* 1  , 1  ) 
call  smgscreate  virtual  aeybcaqccnk  in 


OISPLAT  main  MENU 
10  CONTINUE 

call  smgserase.cisplay<nv:c 
CALL  SMG*0LT_C>-AQS<NVlC,#*i 
CALL  SMGSPLT^CMARSCNVIC,': 
CALL  SMGSPLT_CMARS(NVIC,#2 
CALL  SMGS?LT_CMARS(NVIC,#3 
CALL  SMG SPL  T_CMAPS( NV  IC ,  *4 
CALL  SMG1PLT_CMARSCKVIC.#5 
CALL  SmGSPLT_ChaRS(NVI0.'6 


£  s  S  t  “din  “f  nu  '  ,  P 

Select  0  * t  *  ModeI  ',10,25) 

Set  $  c  «  1  e  V sluts', 11, 25) 

Select  Recession  V*ri*l)Xes',l 
5  u  n  Iterrticn'*  13*25) 

0  i  5  d  1  fi  y  Results'*  14,25) 

E*it', 15, 25) 
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,25) 

2,25) 


c  PROMPT  FCP  «E  NU  C  M  0  !  C  f 

C 

15  CONTINUE 

CALL  S^GlPLT.C^A-SCNViC,  'Enter  Ooic«(l-6):  #  *  1  3  ,  :  5  ) 

CALL  SKG»R5a3_ST  =  :nG(NK!!:-,AnS*,1*,.*nC.,NVI3) 

C 

C  <CR  >  ?  -  EXIT 

C 

I  F(NC . EC .0 )G0  t:  100 

c 

C  CHCICE  *  6  ?"  --  EXIT 

c 

IF( ANS. EG.  '6 -)GC  TO  100 
C 

C  CHCICE  =  1  ?H  --  SELECT  DATA  HOTEL 

C 

IF(ANS.NE.#1#)GC  TO  20 
CALL  SCM 
GO  TO  70 
C 

C  CHOICE  *  2  ?"  --  SET  SCALE  VALUES 

C 

20  CONTINUE 

IFCANS.NE.  #  2  * ) GO  TO  30 
CALL  SSV 
GO  TO  70 
C 

C  CHOICE  *  3  ?  --  SELECT  REGRESSION  VARIABLES 

C 

30  CONTINUE 

IFCANS.NE.  '  3  #  )  G  G  TO  40 
CALL  S  R  V 
GO  TO  70 
C 

C  CHOICE  *  4  ?  --  Run  an  iteraticncs) 

C 

40  CONTINUE 

IFCANS.NE.  '  4  * ) GC  TC  50 
CALL  RUN 
GO  TO  55 
C 

C  CHOICE  *  5  ?  -  OISPLAV  RESULTS 

C 

50  CONTINUE 

IF(ANS.NE.*5')GC  TO  60 
55  CONTINUE 
CALL  RES 
GO  TO  70 
C 

C  3  A  0  CHCICE  -  SEND  MESSAGE  and  PROMPT  PC?  anC^mc?  CHOICE 

C 

60  CONTINUE 

call  SHGtS=ASE_LlNE(NV 10*18. 25) 

CALL  SEEP 
GO  TO  15 
70  CONTINUE 
GO  TO  10 

c 

C  CLOSE  OUTPUT  PILE,  I*  0  P  E  N  E  C  -  E*IT  c?:-  p r C G R A * 

c 
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ioo  c:ntinl i 

i?c  ioc.sc.ogo  tc  iio 

CLCSc('JMT«LUN1) 

lie  C  3  N  T  I  N  L  £ 

CALL  $*G*c«AS£_CI$PLAY<*VIC> 

CALL  SkG»SET_CUBS0R„4BSCNVI0.1.1) 

CALL  EXIT 
E  NC 

SUBROUTINE  SEE? 

C 

C  RINGS  ThE  E  E  L  L  C  N  T  h  E  TERMINAL 

C 

COMMON  /UNITS/  NV  10  ,NKIO, LLN1 ,  I CC  ,  I NP  IL 
CMA  R ACT  6  RSA 0  INF  II 
CALL  SMGSRIsG_5ELL(NV:o 
3  E  TURN 
E  NO 


4  7 


SU9R0UTINE  SC* 


C 

c 

C  SELECT  OATA  *OCEL 

C 

C  LETS  TfE  USES: 

C  I)  SELECT  THE  INPUT  DATA  FILE 

C  2)  CHOOSE  A  2-WAY  CP  N-'JAT  ANALYSIS 

C  2  )  INITIALIZES  FC«  0  T  h  E  R  ROUTINES 

C 

c 

COMMON 

common 

COMMON 
C  OMMON 
X 

COMMON 
COMMON 

c 

DIMENSION  J  S  (  2  ) 

C 

CHARACTERS  ANS.FACTR 
CHARACTERS  0UM(6),INl*4t0UMAcl2 
CHARACTERSO  lNFlL,ITITtlNP60 
C 

CALL  SMGSEPASE  C  ISPLAYCNVIC  ) 

c 

C  PROMPT  FOR  INPUT  OATA  FILENAME 

c 

10  CONTINUE 

CALL  SMGiPLT_CMARSCNVIC.  #Entt  r  Fil«N?fr*  -  <CR>  tc  E»lt:  *•23.10) 
call  smg*R5ao_stringcnkio.infil,,ie...,nc..nvic) 
c 

C  <  C  R  >  ?  --  EXIT 

c 

IFCNC.  EO.O)GO  tc  200 

CALL  SMG*ERASE_LINECNVIO,20*1) 

C 

C  OPEN  INPUT  OATA  FILE 

C 

0PEN(UNIT*LUN1,SAME«:nFIL,TYPE*'CLC',ERR*20) 

GO  TO  30 

c 

C  ERROR  TRAP  -  SEND  MESSAGE  anQ  Frcmpt  AGAIN  FOR  FILENAME 

C 

20  CONTINUE 
CALL  BEEP 

CALL  SKGJECA$E_LINE(NVI0.23*1) 

CALL  SMGS?LT_C*ARSCNVIC.#Fil*N*irt  ret  found*,  2C  ,  10) 

GO  TO  10 
C 

C  READ:  1)  TITLE  2)  *FACTCp$  3)  L  c  v  E  L  *  C  R  EAC*  c  a  C  T  :  =• 

C 

30  CONTINUE 

CALL  SMGIER ASE.L INE(NVI0,23, 1) 

CALL  SMGSPLT.CMAPSCNVIC,  *C  0  *  i  1  •  3*, 23. 10) 

REAO(LLN1,SOO)ITIT 

REACCLLN1.S  0 1  )  N  F 

REA0CLLNI,SC1>CLEVCI),I=1,\F) 

L  E  V  C  7  )  =  1 


/UNITS/  NVI0,NKI0,LUNI,ICC,INFIL 

/  P  A  R  A  M  /  N E . N1 f N2 , NN. N V , NU , MF  , ML • NF , L E V(  8  )  t F AC T R  ?  ) 
/FLAGS/  NOFLG , N2FLG . NNFLG 

/RAW/  DATlC30)tCAT2C250),CATC300),SC9.5).ISCC3,5), 
IClC30,6),IC2C250*6)»IC!C300*E)»TCa»5) 

/ R  E  C  R /  YC250).CC250,27),w(27),ISvC27).Ch:SC*PCh:$; 
/RUN  RES/  NITER.NST5PS.N5AC.MSTSPS.SS2E 
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LE V( 3  )*  1 
MF I sHF-2 


C  R  e  A  0  :  1)  »  1  -  W  A  Y  OATA  POINTS  2  >  T  M  c  1-WAY  OATA  PClNTS 

C 

REACdlNl.SODM 
00  5  0  1  *  1  ,M 

R6A0(LL'N1,$03)(I01(I*J)»J*1*MFI)#0AT1(I) 

50  CONTINUE 
C 

C  R  E  A  0  :  2)  • 2-wa  y  DATA  PCI  NTS  2)  T  m  E  2-way  OaTa  p  C  I  n  t  S 

C 

REA0CILN1V?01>N2 
00  60  I  *  1  #  K  2 

REA0<LUNlf«03X:02CItJ>tJ«lt.HFO.3*T2CI> 

60  CONTINUE 

r 

C  R  £  A  C :  1)  *  N - W  A  Y  DATA  PClNTS  2)  THE  N-WAT  OATA  PClNTS 

REACCLUNl.SODNN 
CO  70  I*  1  ,  NN 

REA0CILN1, $03X10(1, J),J*l,HFI)tCAT(I) 

70  CONTINUE 

CL0$E(LNIT=LUN1 > 

C 

C  DISPLAY  the  INPUT  OATA  FILE  PARAMETERS 

C 

CALL  SMG$ECASE.LINE(NVIC,23,  1) 

CALL  SHG*PLT_CmA3$<nVIC,  'File:', 1,10) 

CALL  SMGlPLT_CHARS(NV!C,'Title:'*2,10> 

CALL  SMG*PLT_CHA*S(NVlC,'*Fctrs:',5,lC> 

CALL  SMGJPU.CHlRSCNVIC.'el-Wjvr'.E.lO) 

CALL  SMG»PLT_CHARS(NVIC,'t2-W^y:#,7,lO) 

CALL  SHGSPLT_CHA3SCNVI0,'*  -Wry  :  '  ,  E  ,  1  0  ) 

Call  Shgaplt.chacscnvic,Infil,i.20) 

CALL  SMG*PLT_CHARSCNVIC,ITIT,2,20> 

ENC00EC1 , 9  C  2 , IS)NF 

CALL  $PGSPLT.C»ARSCNVXCtXNCi:i)«5920> 

Call  Smg*plt_charscnvic,Inci  :  i ) ,  b  ,  1 1 ) 

00  wo  1*1  ,nf 

ENC00EC2,9CAtDuM(I))LEV(I) 

AO  CONTINUE 

0UHA*0UH(1)//DUHC2)//0LH(3)//DL,M(4>//CUH(5)//DL'M(6) 

I  0  s  N  F  C  2 

IN* '(Levels : *//CUMA(i :I9)//')' 

I  9  *  I  B  *  9 

CALL  SHG»PLT_CHARS(NVIC,lN(i:l5),5.26) 

ENC006(2,9CA , I N ) N i 
10*1 

I  F  (  I  N  (  1  5  1  )  ♦  E  C  «.  '  )  I  2  *  2 

CALL  SHG»PLT^CHARS(NVI0,IN(I5:2),6,2C) 

E  NCOOE ( 3 ,9C  5 , IN )N2 
19*1 

IF( INC  1 : 1 >• EC. '  '  )  19*2 

IF( IN(2 : 2). EC.  '  '  )  I  9  *  3 

CALL  SMG*PLT_CHAPSCNV:0,IN(I9:2),7,20> 

ENC00E(3,9C5, I N ) N  N 
19-1 

I  F  (  I  n  (  1  :  1  ) .  E  0  .  '  '  )  :  S  *  2 

I  F(  X  N( 2 : 2 ) . SC  .  '  ' ) 1 9  *  3 
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c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


CALL  S*G*PLT_C*ASS(.SVIC.IN<:*:3).9.20) 

CALL  SHG»MASE_LlNc(NVlC.23*l) 

CQ  A  2- WAY  ANALYSIS  ? 

CALL  SHGlPLT_CHASS(NVIC,#P*rforw  *  2  -  «*  a  y  Analysis  (  Y  /  N  )  ?  *,23.10) 

Call  SPGSRE  aD.STRINCCNK 10. anS. . 1 . . . ,NC, . NVI 0  ) 

CALL  SPG*ERASE_UInE(NVI0.23,1) 

I  F< ANS . NE .  * Y  •  . ANO. ANS . NE . *y ' )G0  TO  190 

PACK  Y  A  NO  N  E  P  C  R  A  2-WAY  ANALYSIS  -  SET  FLAGS 

03  90  I«1  ,K2 
TCI)«0AT2CI) 

90  CONTINUE 
N  E  *  N  2 
N  2  F  L  G  s  1 
NNFlG*C 
GO  TO  190 

DC  A  N-WAY  ANALYSIS  ? 

100  CONTINUE 

ENCOOECl *9C2  *  A  N  $ ) N  F 

IN*  *P«rforir  a  •✓✓A.NS//#-Mny  Analysis  (Y/N)?"* 

CALL  SPG»PCT„CHARS(NVIC*IN(1:32)*23*1C) 

Call  spgjreao.stringcnkio.ans.  *  1  *  * . ,  n  c  . *  n  v i c ) 

CALL  SKG»ERASE.LlNc(NVIO*22*l) 

IFCANS.NE* *  Y *.ANO.ANS.NE*  *  y  *  )  G  C  TO  200 

PACK  Y  ANO  NE  e  C  R  A  N-WAY  ANALYSIS  -  SET  p  L  A  G  S 

00  1  00  1  *1  . NN 
YCI  )  s0 A  T  (I  ) 

SET  PARAMETERS  -  INITIALIZE  arrays,  ETC.  fcp  the  other  SOUTINES 
100  continue 

NE  *NN 
NNF  L  G* 1 
N  2  F  l  G  =  0 
190  CONTINUE 

noflg*i 

NV*  0 

NW«NF^NF*(NF-1)/2*NF*(.NF-1)s<NF-2)/6*2 
00  195  1*1. MF 
00  195  J* 1 t  ML 
SCI, J)*0.0 
T(I,J)*0.0 
I  SC  C I  ,  J)*0.0 
195  CONTINUE 

00  205  1=1,27 
I  S V  <  I)*C 
w  (  I  )  *  0 . 0 
205  CONTINUE 
CHI$0*0.0 
PCHI  SG*0.0 

EXIT  TC  ••AIN  -menu 
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:oo 


900 

901 
9  0  2 
903 
90<- 
905 


COM  INU6 

CALL  SPGS5SA$E_CIS*IAY<KVIC) 
RETURN 

FORMAT (A  ) 

FCRMAT(6I4) 

FORmaTC I  i  ) 

FQ5MATC6I  1  ,F8.0) 

FORMAT ( I  2) 

F  0  R  M  A  T  (  I  3  ) 

ENC 
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subroutine  s r V 


c 

c 

C  SELECT  REGRESSION  VARIABLES 

C 

C  lets  THE  U  5  E  R : 

C  CESIGN  THE  MATHEMATICAL  S  T  F  MODEL  BY 

C  SELECTING  REGRESSION  VARIABLES. 

C 

C 

COMMON  /UNITS/  KV!0.NKI0*LLN1.ICC,INFIL 

COMMON  /PAGAM/  N E  ,  N  1  ,  N 2 , NN , N V , N U , M F  , M L , N F  ,  L E V (  8  )  t  F A C T P C 8  ) 
COMMON  /FLAGS/  NOFLG.N2FLG.NNFLG 

COMMON  /RAW/  0  AT  1C  30) .CAT2C  2  50) , CAT C  300) , SC  8 , 5 ) , ISC C 8  ,  5  )  , 
X  IC1C30,6),I02C250,6)»IOC300»6)»TCS,5) 

COMMON  / R  E  G  R /  TC  2  50) ,CC  250. 2  7  ) , WC27 ) , ISVC 27 ) ,CHIS2 , PChI SO 
COMMON  /RUNRES/  NITER, KSTEPS.N8AC.MSTEPS.SS2E 
C 

Character*!  ans . facts 
CHARACTERS?  TNC  2  > 

Character*! t  VARFHC27) 
c  H A  R  AC  T  E  ft a 4  Q  INF  1L 
CHARACTERseO  lb 
CHARACTER*! 20  INI 
C 

DATA  YN/ #  KO  '  .  '  Y  ES  */ 

OATA  IRON, IROFF/ 15 , 0/ 

C 

CALL  SMGSEGASE.CISPLAYCNVIC) 

C 

C  WAS  DATA  mCOEL  SELECTED  ? 

c 

I  FCNOFLG.EC . 0)GC  TO  90 
C 

C  DISPLAY  all  POSSIBLE  REGRESSION  VACIASLES  TC  CHCOSE  F  ft  C  * 

C 

CALL  SMGS0KAw_LINECnvIC,2,5,2,7O 
CALL  SMGJ0RAw_LINECNVIC,18,5,18,74) 

CALL  SMG*0RAW_LlNECNVlC,22,5,22,7O 
CALL  SMGSOGAW^lINECNVIC.2,39,18,39) 

CALL  SMGiORAW_LlNECNVIC,2,40,18,40) 
lN*#Varf  Variable  Fo  rir  Salacttd' 

INI  *  INC  1 t  30 )// #  V/INC  1  :  30 

CALL  SMGJPLT_CHARSCNVIC,IN1C1:70),1,5) 

00  8  0  1*1  ,  KW 

ENCOOEC3.9CO, IN)  I 

IOX*ISVCI)M 

I  L  *  I  ♦  2 

10*5 

I C  2  *  2  9 

IFCI.LE.14)G0  TC  70 
I L *  I L-  1  4 
10*45 
I C  2  * 69 
70  CONTINUE 

CALL  SMG»PLT.CHAPSCNVI0,INC1:3),IL,IC1) 

CALL  SMGSPLT.CHAftS(NVIC,YNCI0X),lL,IC2) 

80  CONTINUE 
C 

C  ENCOOE  ALL  1-WAY  COMBINATIONS 
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c 


I  v  *  o 

DO  100  1*1, NF 
I  V  *  I  V  ♦  1 

EnCOOEC14#S03,VARFmCIv))FaCTRCI) 

100  CONTINUE 

IFCNF.LT. 2)GO  TC  130 
C 

C  ENCOOE  ALL  2-WAY  COM3INATICNS 

C 

00  110  1*1  *  N  F  -  1 
00  110  J*IM,NF 
I  V*  I  V ♦  1 

ENCD0EC14,S04#VARFMCIV))FACTRCI),FACTRCJ) 

no  continue 

IFCNF.LT. 3)G0  TC  130 

c 

C  ENCODE  ALL  3-WAY  COMBINATIONS 

C 

00  1  20  1*  1  »  NF -  2 
DO  120  J*m  *  NF-  1 
00  1  20  K  *  J ♦ 1 , N F 
I  V  *  I  V  ♦  1 

ENC0DEC1A#S05,VARFMCIV))FACTRCI),FACTRCJ),FACTRCR) 
120  CONTINUE 
C 

C  ENCODE  INITIAL  IMPRESSION  -  SCO) 

c 

130  CONTINUE 
I  V* I v*l 

ENCCDEC 14 ,506»VARFMCIV)) 

c 

C  ENCODE  RANGE  variable  -  SCR) 

C 

I  V  *  I  V  ♦  1 

ENC00EC14,907,VARFMCIV)) 

C 

C  OISPLAY  ALL  VARIABLE  FORMS 

C 

DO  140  1*1, NU 
I  L  *  I  ♦  2 
IC*  1  1 

IFCI.LE.14)G0  TC  145 
IL*IL-14 
I  C  *  5  1 

145  CONTINUE 

CALL  SMGSPLT_CHARSCNVIC,VARFMCI),IL,IC) 

140  CONTINUE 
C 

C  OISPLAY  ^VARIABLES  SELECTEC,  VARI A2LES  SELECTEC 

C 

CALL  OISPCV 
60  CONTINUE 

CALL  SMGiERASE„LlNECNVIC,23,l) 
iNa'Ust  SPACE  BAR  to  wove  Line  Cursor 
IN1*1NC1  :36)//*<CR>  to  CUn)S#l*ct  i  vrr  inl>l#- 
CALL  SMGiPLT_CHARSCNVlC,lNlCi:67),23,5) 

I  P  T  *  1 
IL*  1PTW 
I  C  *  6 


i.*  l 


o  o  o  oor>  non  non  non  n  n  n  o  n  n  n 


CALL  SFGKH  ANGE.RENOIT  ICNCNVIO.  IL  •  IC  ,  1  .  26  ,  IRON.O) 

BEGIN  LOOP  FOR  SELECTING  VARIABLES  —  R£A0  CHOICE 
SPACE  *  NO  CHANGE  <CR>  *  CHANGE 


10  CONTINUE 

Call  shgsreao.stringcnkio , ans. , i , , , ,nc, , nvio) 

CALL  SPG»CHANGE„RENOITlON(NVIOtIL,ICtl.26fIRCFF.O) 

IFCNC.EQ. 1 )G0  TO  40 

<  C  R  >  —  CHANGE  A  “YES'*  TC  "NO"  OR  A  "NO**  Tt  "YES"  —  UPDATE  COU 

IF( I  SVC IPT). EQ. 0)NV*NVM 
IPCISV(IPT).EQ.l )NV*NV-1 
ISV(IPT)*1-ISV(IPT) 

IOX*ISV<IPT)M 

CALL  SHGSPLT.CHARS(NVIO,YN(IOX),IL,lC+23) 

OISPLAY  iVARlABLES  SELECTEC,  VARIABLES  SELECTEC 
CALL  OISPCV 

SPACE  BAR  --  NO  CHANGE  —  LCCP  TO  NEXT  VARIABLE 

40  CONTINUE 
IPT*IPT*1 

IPC IPT.GT.NW)GO  TO  30 
IL*IPT*2 
I C*  6 

IPCIPT . L  E . 1 4 ) GO  TO  20 
IL*IL-14 
I  C  *  4  6 

20  CONTINUE 

CALL  SHGSCHANGE^RENOITION(NVIO,ILfIC,l  26  ,  IRCN,0) 

GO  TO  10 

ENO  OP  LOOP  —  CONFXRH  SELECTION 
30  CONTINUE 

CALL  $MG*ERASE_LINE(NVI0,23»  1) 

CALL  SMGIPLT.CH ARSCNVIO, #Is  this  Ccrrcrt  (Y/O?  ',23.5) 

CALL  SHGtRE AO.STRINGCNKIO, ANS, , 1, , , ,NC  ,NVXO 
IPCNC.E0.0)G0  TG  50 

IP(ANS,NE.*N#.ANO-ANS.NE.*n')GC  TO  50 
GO  TO  60 

OATA  HOOEL  NOT  SELECTEO  -  SENO  HESSAGE  ANO  EXIT 

90  CONTINUE 
CALL  BEEP 

IN*  *  No  Oat?  Hod  1 1  S«  1  «c  t «d  ' 

CALL  SHGSPLT.CHARSCNVI0,IN(1:22), IC,30) 

IN**Sa#  Option  1  in  Main  Mtnu* 

CALL  SHGiPLT_ChARS(NVIO,lN( 1 :25), 12 ,30) 

CALL  SHGtSET.CURS0R.A6S(Nv 10, 16,30) 

CALL  SHG*REA0„STRING(NXI0,ANS, 

X  *Ppt55  any  X  E  Y  to  RtturnM  ,  ,  ,  ,NC  ,  ,NVlO) 
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c 

C  EXIT  TC  MAIN  MENU 

c 

50  CONTINUE 
RETURN 

900  F0RMATCI3) 

903  FORHATC  *S( ' . A1 t ')  '> 

904  FORMATC #S< * ,A1 # #  )*S( #,Mt *)  '> 

905  FORHATC  VS( *  »A1 9  9  )*SC  V»A1 • V)*SC  *• A1 . *) *) 

906  FORMATC'S(C)  *> 

907  FORMATC'SCfi)  *) 

ENO 

SUBROUTINE  oispcv 
C 

C  OISPLAYS  the  »VARIA8LES  selecteo  ano  which  variables  were  selecteo 

c 

COMMON  /UNITS/  NVIO9NKIO9LUNI • IOC  » I NF I L 

COMMON  /PAR  AM/  NE,N1,N2,NN,NV,NW,MF,ML,NF,LEV(8),FACTR(8) 

COMMON  /FLAGS/  N0FLG,N2FLG , NNFLG 

COMMON  /RAW/  0AT1(30>,0AT2C250),CAT(300),SC8,5>,ISCC3,5), 

X  IC1(30»6),I02(250*6)»I0(200»6>*T(8,5> 

COMMON  /R  EC  R /  YC  250)  ,C<250, 27) , W(27 ) , ISV( 27 ) 

COMMON  /RUNRES/  N I T E R , NS T E P S . N 8  A  0 , H S T E P S * S S Z E 
C 

Characters!  Facts 
CHARACTERsAO  9  IKFILf IN 
c 

00  40  1  *  1 9 » 2 1 

CALL  SMGIERASE.LINECNV 10,1.1) 

40  CONTINUE 
C 

C  ENCOOE  ANO  OISPLAY  «VARIA8LES  SELECTEC 

C 

ENCOOEC  22 ,300  , IN )NV 

CALL  SMGSPLT.CHARSCNVIC. IN<1:22>, 13 ,5) 

CALL  SMG*PLT_CHARSCNVIO,'Stl«cttd  Variabl«s:’»20»S) 

IF(NV,EC,0>G0  TC  30 
N  S  *  0 

00  20  1*  1  , NW 

IF(ISV(I>,EQ.O)GO  TO  20 
NS*NS* 1 
I  L  *  2  0 

I  C* (NS- 1  )$2 ♦ 24 
IF(NS*LE. 14)G0  TC  10 
I  L  *  2  1 

I  C*  C  NS- 1 5 )s  3^  24 
10  CONTINUE 
C 

C  ENCOOE  ANO  OISPLAY  VARIASLE*'S  SELECTEO 

C 

E  NC OOE (3,9C1,IN)I 

CALL  SMGSPLT.CHARSCNVIC, IN(  1 :3)  ,  II  ,  IC) 

20  CONTINUE 

c 

c  RETURN  TO  "SRV" 

C 

30  CONTINUE 
RETURN 

100  FORMATC 'Cur r#nt  •Variables :  ',13) 

901  F0RMATCI3) 


ENC 
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SUBROUTINE  res 


c 

c 

C  OISPLMS  TKE  RESULTS  0  F  THE  1TERATICNCS)  AND  LINE  SEARCk 

c 

C  SCREEN  1:  DISPLAYS  INITIAL  A f  D  NEW  SCALE  VALUES 

C  SCREEN  2:  CISPLAYS  WEIGHTS 

C 
C 

COMMON 
Common 
COMMON 

common 

X 

COMMON 
COMMON 

c 

characters  ans,factr 

CMARACTERS2  BLR.IN2 
CHARACTERS**  VARFm(27) 

CHARACTERSO  INF1L 
CHARACTER*eO  IN 
CHARACTERS20  IM 

c 

OATA  3LK/#  V 

C 

CALL  smgsecase.cisplaycnvio 

c 

C  WAS  OATA  MCOEL  SELECTED  ? 

c 

IF(NOFLG*EC.Q)GC  TO  200 
C 

C  OISPLAY  SCALE  VALUES  ANO  “TEST”  SCALE  VALUES 

c 

00  10  I  *  1  ,  E 
E  NCGOE ( 1 2  *  S  OS  » IN2)I 
J * < I - 1) *  1 2  *  1  2 

CALL  SMGSPIT_CHARS(NVIC,1N2.1.J) 

10  CONTINUE 

DO  20  1 *1  ,  NF ♦ 1 
U*  I 

1 F(  I  •GT.NF )1K*7 
XL*CI-l)»3+2 
K*LEV<IK> 

NCHbK*1 2*7 

ENCOOECNCH, 909, IN)F  ACTR( IK ) , (SC  IK • J  )  .  J*1  f  X  ) 
lNl*lN(i:NCH)//SLK//5LK//BLK//eLK 

CALL  SMGSPLT.CHARSCNVIC, INI ( 1 :67 ) , I L , 5) 
ENCO0E<NCH,910,IN)(T(IK,J),J*l,K) 

ini*inci:nch)//blk//blk//blk//?lk 
CALL  SMGSPLT.CHARSCNVIC, IN  1 C 1 :€  7) , IL* 1 , 5) 

20  CONTINUE 
C 

C  OISPLAY  THE  PARAMETERS  FROM  THE  lTERATICN(S) 

C 

CALL  SMGlPLT_ChARS(NVlO.#*It«rrtiors:',20,5) 

CALL  SMGSPLT.CHARSCNVIC,  '  »St#ps :  '  ,20, 27) 

CALL  SMCSPLT.CHARSCNVIC, 'CM***  >  # ,  20 , 3  8  ) 

call  SMGiPLT_CHARS(NVIC,  'St*o  Siz»:#,20,5O 
CALL  SMGsPLT_CmaRS(NvIO,  'Current  C  M  1  S  C  :  ',21  til) 


/UNITS/  NVI0,NKI0,LUN1,IGC,INF:l 

/PA  R  AM/  NE,Nl,N2,NN,NV,NW,MF,ML,NF,LEV(8),pACTR(?) 
/FLAGS/  K0FLG,N2FLG,NNFLG 

/RAW/  OAT1OO)»OAT2(25O),CaT(3CO)»S(9»5)»1SC(0,5)i 
ICl(30,6)tI02(250,6) ,10(200,6) »T(8,5) 

/ R  E  C  R/  Y(  250),C(250,27),W(27),1SV(27),CMIS0,PCHIS0 
/RUN  RES/  NITER, NSTEPS,NBAO,MSTEPS,SSZE 
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CALL  S^GtPLT.CHARSCNVlC,  'Previous  CM  X  SO  1  * • 2 1  , 4 5 ) 
SNC0DEC2»9C2»IN2)nITER 

CALL  SKGtPLT.CMAPS(NVIO,IN2(i:2),2C,l7) 

IFCSSZE.LT.  1.0)G0  TO  60 
ENC0CEC2.9C2, IN2)NST£P$ 

GO  TO  90 
60  CONTINUE 

ENC00EC2,9C2,IN2)N3A0 
90  CONTINUE 

CALL  SFGlPLT.ChARSCNVIC.  IN2C  1  :  2).  2C  ,  30 
ENCD0EC2,9C2,IN2)HSTEPS 

CALL  SPGSPLT.CHARSCNVIO, IN2C1 : 2) • 20,43) 

ENCOOEC 1 2 , S 1 1  ,  IN  2)SSZE 

CALL  S^GtPLT_CMA3S(NVlC,IN2,20.64) 

ENC30EC10,$12,IN2)CHISC 

CALL  SKG»PLT-CHARSCNVIO,IN2Ci:iO),2l,25) 

ENC30ECl0,$l2,lN2)PCHISC 

CALL  SHG»PLT_CMARSCNV:C, IN2C 1 : 10) , 21 , 60) 

CALL  SHG*0fiAW_LlN£(NV 10, 19,5,19,75) 

CALL  SHGtORAW.LINECNVlC, 22, 5,22,75) 

s. 

C  SET  THE  SCALE  VALUES  TO  THE  "TEST"  SCALE  VALUES  ? 

C 

I  N  *  '  S  «  t  S  C  *  1  •  Vsluts  tc  T  •  s  t  Rtsulls  ( Y / N  )  ?  ' 

CALL  SHG»PLT.CMARS(NVI0,INC1:40),23,5) 

call  spg*reao.stringcnkio#ans,.i,,,,nc,,nvio) 
call  SHG*£RaSE_LINECNVIG,23,1) 

IYES*0 

C 

C  <CR>  ?H  —  OONT  SET  THE  SCALE  VALLES 

C 

IF(NC.EQ.O)GO  tc  50 

c 

C  ANSWER  IS  NOT  TES  —  OONT  SET  SCALE  VALUES 

C 

IF(ANS.NE.#Y'.ANO.ANS.NE.'y')GC  TO  50 

c 

c 

C  ANSWER  IS  TES  -  -  SET  THE  SCALE  VALUES  TO  The  "TEST”  SCALE  VALUES 

C 

C  RECISPLAY  the  new  SCALE  VALUES  ANO  ZERO  out  THE  "TEST"  SCALE  VALUES 

C 

C 

I  YESM 

00  30  1  *  1  ,  N F ♦  1 
IN*  I 

I  F (  I.GT.NF)IK  =  7 
K*L  EV( I K  ) 

Xl-CX-l)*3«2 

NCM* K « 1 2 ♦ 7 
00  40  J  *  1  •  K 
SC  IK  ,  J)rTC!K  ,  J) 

TCIK,  J)*0.0 
40  CONTINUE 

ENCOOECNCH,  909, IN)FACTR(IK) , C  SC  I K , J ) , J* 1 , K ) 

INI  *  I N C 1 :  nCh)//Elk//0LK//0LK//2LK 
call  SHGiPLT.CHARSCNVIO, INI  Cl  167) , IL , 5 ) 

EnC00ECNCh,910, I N  )  C  T CIK,J),J*1 *  K ) 

Ini *INC 1 • nCh)//8LK//BLK//3LK//2LK 

call  SHGJPLT.CHARSCNVIC, IN1C1I67) ,IL^1 ,5) 


r:  ~ 


c 

c 

c 


30  CONTINUE 


PAUSE  POP  USER  TC  REAO  SCREEN  1 
50  CONTINUE 

IN*'33$  Press  any  KEY  <o r  Next  Screen 

CALL  SHGSPLT_CmaRS(Nv:o.IN(1:<.5).23,17) 

CALL  SMG$REA0_STRING(NU0,AnS,,1,...nC,,NVI0) 

CALL  ShGSEKASE.CISPLAY(NVIC) 

c 

C  BEGIN  SCREEN  2  CISPLAr  0  f  WEIGHTS  ANC  VARIABLE  FORMS 

C 

CALL  SMGS0KAW_LINE(NVI0,2,5,2,76) 

Call  SMGSORAW_lINE(NV 10,18,5,18,76) 

CALL  SMGS0RAW_LINECNVI0, 22, 5,22,76) 

CALL  SHGtORAW_LlNE(NV!C,2,AO,18,AO) 

CALL  SMGS0RAW_LlNE(NVl0,2,M,ie,Al) 
lN**Var«  <3  Weight  Variable  cc rv 

IN1*IN(1:3A)//-  *// IN( 1 : 3  A ) 

CALL  SMG*PLT_CHARS(NVIC, INI < 1 :72 ) , 1 , 5) 

C 

C  ENCOOE  ANO  OISPLAT  WEIGHTS 

C 

I  V  a  0 

00  80  I  *  1  ,  NW 
ENCOOEC 3 , 900 , IN)I 
INI** 

IFCISVC I ). EO.O)GC  TO  65 
I  V* I  V ♦ 1 

ENC00EC12,901,IM)W(IV) 

65  CONTINUE 
I L* I ♦ 2 
I  C  1  *  5 
I C2  *  1 1 

XFCI.LE. 14)60  TC  70 

IL*  IL-1 A 

I  C 1  *  a  3 
I C2  *  A 9 
70  CONTINUE 

CALL  SFG$PLT_CHARS(NVI0,INC1:3)»IL,IC1) 

CALL  SHGtPLT.CHARS<NVlC,lNl<i:i2),:L,IC2) 

80  CONTINUE 
C 

C  ENCOOE  1-WAY  combinations  cf  variable  form 
C 

I  V*  0 

00  100  1*1, NF 
I  V  *  I  V  ♦  1 

ENCOOEC 1A ,903, VARFMC IV ))FACTR( I) 

100  CONTINUE 

IF(NF.LT.2)G0  TC  130 
C 

C  ENCOOE  2-wat  COMBINATIONS  OF  VAR:a!lE  FORM 

C 

00  110  \*l  ,  N  F -  1 

00  no  J  *  I  •*  1  ,  N  F 
I  v*  I V*  1 

ENCOOE<lAt$OA,VARFH(lV))FACTRCI),FACTS(J) 
no  continue 

IF(NF.LT.3)G0  TC  130 
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c 

C  ENCOOE  3-Uflt  CC^SINATICNS  C F  VARIAfiLE  FQRm 

C 

00  1  20  IM.NF-2 
00  1  20  J«M.NF-1 
00  1  20  K  *  J ♦ 1  i NF 
I  V* I  V  ♦  1 

ENC OOE (1^,905, VARFHCIV>)F AC Ta(I)fFACTR(J),F AC TR(K) 
120  CONTINUE 
C 

C  ENCOOE  INITIAL  IMPRESSION  -  SCO) 

C 

130  CONTINUE 
IV*IV*1 

ENC00EC1 4,906, VARFM(IV)) 

C 

C  ENCOOE  RANGE  VARIABLE  -  S(R> 

C 

I  V»  I  V  ♦  1 

EnCOOE(14,907,VARFM(IV)> 

c 

C  OISPLAT  THE  VARIABLE  FORMS  JUST  5NCCOEO 

C 

00  140  1*1 ,NW 
I  L  *  I  ♦  2 
I  C  *  2  5 

I  F ( I „ L E . 1 4 ) GO  TO  145 
IL*  IL-1 4 
I  C  *  6  3 

145  CONTINUE 

call  SFGSPL'T.CHARSCNVICtVARFHCDfXL.IC) 

14Q  CONTINUE 

c 

C  OISPLAT  PARAMETERS  FROM  ITERATICNCS) 

C 

CALL  SHGSPLT_C*ARS(NVIC,'*Ittratiors:',20,5> 

CALL  SFG*PLT^CHARS(NVIO,#»St*Ps:  ',20,27) 

CALL  SHGiPUT^CHARSCNVIO,  '(Max*  )',20,38) 

CALL  SHGSPLT_CHARSCNVIO,'St«D  Siz»:  ',20,54) 

CALL  SMGSPLT^CHARS(NVlO,'Currtnt  CHISC:  ',21,11) 
CALL  SHG*PUT_CMARSCNVIC,  'Pr tviouS  C H  I  S Q :  '  , 2  1  ,  4 5  ) 
ENCOOEC  2  *  9C  2  * IN2)NITER 

CALL  SPGlPLT.CHARSCNVXOvXN2(i:2>»2C»17) 

IFCSS2E.LT. 1.0)GO  TO  160 
ENCOOEC  2 ,9C  2, IN2)NSTEPS 
GO  TO  190 
160  CONTINUE 

ENC00EC2,9C2,IN2)NBA0 
190  CONTINUE 

CALL  SMG*PUT_CHARSCNVIC,In2C1:2),2C,34) 
ENC00EC2,9C2,IN2)MSTEPS 

CALL  SPG*PLT_CHARSCNVIO, IN2C1 :2),2C,43) 

ENC00EC12, S 1 1 , IN2)SS2E 

CALL  SFGSPLT_CHARSCNVIC,IN2,20,64) 

ENCOOEC 1 0 , 9 12 , IN2 )ChISC 

CALL  SMG*PLT^CHARSCNVIO,IN2Ci:iO)',  21,25) 
ENCOOEC10,912,IN2)PCHISC 

CALL  SMGSPLT_CHARSCNVIC,lN2Ci: 10), 21,60) 

c 

C  HAS  THE  SCALE  VALUES  BEEN  SET  TO  THE  "TEST"  SCALE 


values  ? 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


I  F  c  I  YES.EQ. 1 >GG  TC  250 

I  N «  #  S  •  t  Sc  ?  1  •  values  to  Test  Pnults  (  Y  /  N  )  ?  ' 

CALL  SHGIPLT_CMAPSCNVIC.INC1:40),23,5) 

CALL  SFG»RSAD_STRlNG<NKXO,ANS.tlf.,.NCttNVID> 

CALL  SHG46R ASE.L  INECNVIO.  2?  ,  1  ) 

<  C  R  >  ?  —  OONT  SET  THE  SCALE  VALLES  TC  THE  TEST  SCALES 

If (NC.EQ.O)GO  TC  2  4  0 

ANSWER  IS  NO  ?h  --  OONT  SET  THE  SCALE  VALUES 
IfCANS.NE.  'Y'.ANO.ANS.NE.  *  y  * ) GO  TO  240 

ANSWER  IS  YES  --  SET  SCALE  VALUES  TC  HTESTH  SCALE  VALLES 

00  230  IO.NPM 
U«I 

IP(I.GT.NP)IK»7 

K*LEV<IK) 

00  230  J*1,K 
SCXK»J)«TCXIC9J) 

T(IK*J)*0.0 
230  CONTINUE 
GO  TO  250 


OONT  SET  THE  SCALE  VALUES  TC  THE  "TEST"  SCALE  VALUES 
RESET  THE  VALUE  CP  CHISC  ANO  RECISPLAY  IT 


240  CONTINUE 

CHISQ*PCMISC 

ENC00E(10,912.IN2>CMISC 

CALL  SKGSPLT_CHARS(NVIO , IN2< 1 : 10)  .2 1  ,  25  > 

SAVE  THE  RESULTS  ON  A  PILE  ? 

250  CONTINUE 

IN*  'Save  Results  in  *  Pile  (Y/N)?  * 

CALL  SHGSPLT.CHARSCNVIO,IN(i:23)#23,5> 

CALL  SPG»REAO.STRING(NKIO,ANS.,l,,t,NC,*NVlO) 
CALL  SKGSERAsi_LlNECNVlD,22*l) 

<  C  R  >  ?  —  OONT  SAVE  THE  RESULTS 

IP(NC.EQ.O)GO  TO  210 

ANSWER  IS  NO  --  OCNT  SAVE  THE  RESULTS 
IF(ANS.NE*'Y'.ASG.ANS.NE.  '  y  '  )  G  C  TO  2  1C 
ANSWER  IS  YES  --  SAVE  The  RESULTS 
IS  the  OUTPUT  FILE  ALREACY  C  R  E  4  S  l  ? 

IP(  IOC. EC. 1 )G0  TC  260 


GO 


90  8  FORMAT?  '  Level  Ml) 

909  FORMAT?  'S?  #,A1.  ')  •,5F12.2) 

910  FQRHAT?'Test  '.5F12-3) 

911  F0RMAT?E12.6) 

912  F0RMATCF10.4) 

913  FORMAT? 1 X ,  'Fi l#N*at:  '.  A40) 

9  1*  FORMAT(lXf-»l-Wys:'#I2,5X##«2-W*ys:',I3,5X,#«',Il.'-W?y 

X  X3/lX»'*Factors:#.I1.3X.  #,6I2) 
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FORMAT? 1 X , 

*  •  E  *  cer  i»#o t  s t 

'  *  I  3  •  5  X  , 

»  * »Var iables : '.12.  ' 

o  1 

916 

FORMAT? 1 X , 

I3.23X.A14) 

917 

F  ORM AT  ? 1 X  , 

I3.4X.E16-8.3X 

.  A14) 

918 

format?  IX  , 

5  F  1  4 . 4  } 

919 

FORMAT  ?/  IX 

.  #CMI sc  :  ' .  E  1  6  * 

8////) 

920 

FORMAT?/  IX 

. #  Sc  a  I •  Values 

') 

921 

F0RMAT?/1X 
E  NO 

,  'Van 

weight 

<«ee 

Variable  Fore 

') 
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o  o  o  o  o  n  o 


SU9RCUTIN6  SSV 


SET  SCALE  VALUES 

LETS  THE  USES: 

1)  SET  SCALE  VALUSE 

2)  SET  CONSTRAINTS 

c  3)  change  a  scale  value 

c  A)  change  A  constraint 

c 
c 

COMMON  /UNITS/  NVIO  .NKIOfLUNl • ICC , INFIL 

COMMON  /P AS  AM/  NE,NlPN2,NN,NV,NW,MF,ML.NP,LEV(9)tPACTP(9) 
COMMON  /FLAGS/  NQFLG.N2FLG.NNFLG 

COMMON  /RAW/  OAT  1 (30)  ,CAT  2(  2  50  ) , CAT(  300  ) , S( 9 , 5  )  , I SC( ?  ,  5  )  , 
X  ICK30. 6). 102(250, 6), 10(200. 6).T(3, 5) 

COMMON  / R £ C R /  Y(250),C(250,27),W(27),ISv(27),CMIS0,PChi$0 

COMMON  /RUNRES/  NITER, nSTEPS,N8A0,MSTE?S.SS2E 
C 

OIMENSION  CNT(9,5),LEVEL(5) 

C 

CHARACTER*!  fact  r  ,  a ns. level 
CHARACTER*! 2  8LK  ,  INI 
characte r*  *  o  infil 
CHARACTER*EO  in 
CHARACTER*120  I N  2 

c 

DATA  9  L  K  /  #  V 

OATA  LEVEL/  '1  '2  ,  '3',  *4',  '5'/ 

C 

CALL  SMGSEfi ASE.CI SPLAT(NVIO) 

c 

C  WAS  A  CATA  model  SELECTED  ? 

c 

if(noflg.ec.o)g:  to  <.90 

c 

C  OISPLAY  CURRENT  SCALE  VALUES  AND  THEIR  CONSTRAINTS 

C 

00  10  1*1,5 

E  NC  C  D  E  (  12.500.IM  )  I 

J*(I-l)tl2M2 

CALL  SMG*PLT.CHARS(NVIC, INI  .1  t J) 

10  CONTINUE 

CALL  SMGSPLTwCharS(NVIC,  '*ScMt*  1  •  5) 

00  20  I*l.Nr+l 
IX*I 

I  F  ( I.GT.NF)IK*7 

IL*(I-1)*3«2 

K*LEV(IK) 

NCH*K*12^7 

ENCOOE(NCHt9oi,:N)PACT»(u)#(sc:N,->)lj*itio 

IN2*IN(i:nCm)//ELF//6LF//5LK//?LX 

call  SMGSPLT_CMARS(NV!C,lN2(i:67)tIL,£) 

ENCC0E(NCH,902.IN)(!SC(I*,J).J*i,K) 

IN2*IN(1:NCH)//6L<//2LJC//9LK//9LF 

CALL  SMGIPLT^C^ARSCNVIC. I N  2 ( 1 : 6  7 ) f I L ♦ 1  ,5) 

20  CONTINUE 
C 

C  OISPLAY  SUE-mENL 
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c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


NO  -  -  2 1>  E  N  The  MIE  AND  SET  c  L  A  0 

OPEN(UMTsLUNl,KAM6*'3ESULTS,ST.p#.TTPE*'NCU') 
IOC*  1 

WRITE  THE  JESUITS 

260  CONTINUE 

WRITE(LUN1,913)Inf:i 

WRITECLUNl, 910M,N  2. NF,NN,NF,(LEVCI)fI*l.NF) 
WRI TECLUN 1 , 91 S )NE , NV,NW 
WRI T  E ( LUN 1*921) 

I  V  *  o 

00  2  70  I  =1  ,NW 
XF(XSV(I)»EQ#1)50  TC  275 
WRITECLUNl, 916)1, VAPFmCI) 

GO  TO  270 
27S  CONTINUE 
I  V*  I  V ♦  1 

WRI  TE(L UNI, 917)1, W(IV), VAR  PMC!) 

270  CONTINUE 

WRITECLUN1  ,  920  ) 

00  290  1=1, MF 

WRITECLUNl ,91S)CS(I ♦ J ) *  J  *  1  U  ) 

280  CONTINUE 

WRITECLUNl ,919)CHISC 
GO  TO  210 

NO  OATA  MOCEL  SELECTEO  -  SEND  MESSAGE  ANO  EXIT 

200  CONTINUE 
CALL  BEEP 

I N  «  '  N  o  G  ?  t  *  Model  Selected' 

CALL  SMGJPLT_C»“AFSCNV:C,IN(1:22),1C,2C) 

IN*  'See  Cot  ion  1  in  Main  Menu' 

CALL  SMGSPLT.CHARSCNVrn, INC1 T2S) • 12  ,  30 
CALL  SMGJSET.CURSOR.ABSCNV 10,16,30) 

CALL  $MG* RE A0_ S T R  INGC NK I  0 , ANS , 

X  'Press  »ny  KEY  tc  Btturn',1 , , , ,  K  C  ,  •  N  V  X  D  ) 

GO  TO  220 

PAUSE  FOR  USER  TC  READ  SCREEN  2 
210  CONTINUE 

X  N  *  #  *  Press  my  KEY  to  Return  £  S  $  ' 

CALL  SmGJPlT.CHARSCnvic,  I  n (  l  ;  39)  ,  22  ,  20) 
call  SMG*REAG_STPINGCNKI0,ANS,,1,,,,NC,,NV:0) 

R  E  TURN  TC  ^  A  I N  MENU 

220  CONTINUE 
RETURN 

900  F0RMATCI3) 

901  FORMAT ( E  1  2 . 6 ) 

902  FQRMATCI2) 

903  PCRMATC  'SC  *  ,  A1  ,  ')  *  ') 

9  0  m  FORM  a T C  'SC  '  , A  1  ,  ' )s SC ' , A  1 ,  * )  ') 

905  FQRMATC'SC'.Al,  ')*SC'»Al,#)eSC',Al,  ')') 

906  FORMATC  'SCO  ') 

90  7  FORMATC  'SCR  )  ') 


G2 


c 


c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 


c 

c 

c 


30  CONTINUE 

IN* *l*Scalt  C*f ful t  s  3  *  C  c  n  s t  r  ?  in  t  C«  f aul t5 

IN2»lN(i:5C)//#5*5*tu  rr  to  H  ?  1  n  •'tn  u  * 

CALL  S’’GSPlT_Ci-ARS<NV!CvXN2<i:71),20'5) 

IN*'2*Char>ct  a  Seal*  4*Char$*  a  Constraint' 

CALL  SPGSPLT.Cb AQSCNVXC*  XNC 1 7A8 )• 21 . S ) 

CALL  $FG»0RAW_LINE(NVI0,19,5.19,75) 

Call  S*GI0fiAU_LlNE(NVXC922»5»22»75) 

PROHPT  FOR  SU6-F6NU  CHOICE 


35  CONTINUE 

CALL  SFG*PLT_ChARS(NVlC, 'Entir  Choic*  (1-5):  ',23.5) 

CALL  SMGiREAQ_STRlNG(NKIO.ANS..l.,,.NC.,NVIO) 

<CR>  ?  --  EXIT 

IFCNC .E0.0)G0  TC  500 

CHOICE  *  5  ?  --  EXIT 

IFCANS.EC.  '5  '  )  GC  TO  500 

CHOICE  *  1  ?  --  SET  SCALE  VALUES  TC  OEFALLTS 

IFCANS.NE.  '1  ' ) G  C  TO  40 

ERASE  PREVIOUS  SU3-*ENU  --  OISPLAY  NEW  SL3-HENU 


00  100  I  * 2  C  .23 

I  F (  I.EC.22)GC  TC  100 

Call  SPGSERASE.LINE(NVIC.I.I) 

100  continue 

IN* '1*? tans  3 s 1 o g ( M 6  ?  r  3  ) 

CALL  SHGIPlT_CMAR$<NVlCtlN<i:30).2C.$) 
IN='2*1-Ways  4*lcs(l-Ways) 

CALL  SPGSPLT_CHARS(NVIC.:n(1:30).21,5) 

PROMPT  FOR  NEW  SUB-HENU  CHOICE  (CF  CE^AULTS) 


105  CONTINUE 

CALL  SPGSPLT_CHARS(NVIC.  'Enttr  CHoict  -  <C»>  t o " E  - 1  t  : 

call  spgireao_stking<nkio*ans, .i . . . .nc»  » n v : o ) 

<CR>  ?"  --  GO  8  A  C  X  TO  PREVIOUS  SU5-mENU 
I  F( NC . E  C . 0 ) GO  TC  70 

CHOICE  *  1  OR  3  ?"  --  OEFAULT  SCALE  VALUES  TO  MEASS 

IFCANS.NE. '1 '.AN0.ANS.NE • *2  '  )GC  TO  110 
00  1  50  1  =  1  » M  F 
00  1  50  J *  1  »  H L 
SCI. J)*0.0 
CNTCI,J)*0.0 
150  CONTINUE 


CALCULATE  EUM$  -  *EEP  COUNT 


'.23,5) 
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00  155  11*1, ME 
00  1  5  5  1  *  1  ,  N F 

1FCN2FIG.EC.DG0  T°  152 

C 

c  N-WAY  ANALYSIS 

C 

J*I0<II.I) 

IFCJ.EC.0)G0  TC  155 
SCI»J)*5CI*J)*CATCII) 

CNTCI,  J>*CMC  I  *  J  )♦  1 . 0 
GO  TO  155 
C 

C  2-way  ANALYSIS 

C 

152  CONTINUE 

J*I02C  I  I  ,  I  ) 

IF<  J.EC.OKO  TC  155 
$<I,J)*$CI, J)^CAT2<II> 

CNT(I,J)*CKT(I,J)*1.0 
155  CONTINUE 
C 

C  CALCULATE  p  E  A  n  s 

c 

00  160  1*1,  NF 
<*LEV(I) 

00  160  J*l,< 

IF(CNT(I,J).EC.O.O)GO  TC  150 
SCI,  J)*SC  ,  J)/CKT<  I  ,  J) 

IFCANS.EC.  #1  '  )GC  TC  160 
SCI  ,  J)*AL0C10CSCI, J)) 

160  continue 

GO  TC  130 

c 

C  CHOICE  *  2  oa  A  ?  —  OEFAULT  SCALE  values  to  1-ways 

c 

110  CONTINUE 

IFCANS.NE.  *2*.AN0.ANS.NE.  'a  *)GC  TC  125 
OC  115  1*1, MF 
DO  115  J=1,ML 
SCI , J)*0.0 
CNTC  I  ,  J  )*Q.O 
115  CONTINUE 

c 

C  CALCULATE  SUMS  CIC  ANY)  -  <  £  E  p  CCUKT 

C 

00  1  20  1  1  *  1  ,N1 
00  1  20  I  *  1  ,  N F 

J*I01CII,I) 

IFCJ.EC.O)GO  TC  120 
SCI.  J)*$CI, J)*CATl(XX) 

CNTC  I  •  J  )=CK  TC  I  , J  )♦  1  .0 
120  CGNTINUE 
C 

C  CALCULATE  *  c  a  N  S  OF  1-wAYS 

C 

00  1  2  2  1  *  1  ,NF 
<=LEVC  I  ) 

00  122  J*l,< 

IFCCNTCI, J).EO.C.O)GO  TO  122 
SC  I , J)*SC I , J)/CK  TC  I  ,  J) 


f>5 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


IF( ANS.EG. *2 • )GC  TO  122 
SCI, J)*ALOC  IOC  SC  I  , J)) 

122  CONTINUE 
GO  TO  130 

BAG  ANSWER  -  SENO  MESSAGE  A  N  C  AS*  AGAIN 

125  CONTINUE 
CALL  BEEP 

CALL  SPGSERAS6.lXNECHVIO.23il) 

GO  TO  105 

COMPUTE  INITIAL  IMPRESSION  DEFAULT  --  SCO 

4 

130  continue 

SMIN*1 . 0  E ♦ 1 0 
00  1  35  1  *  1  *  N F 
K*LEVCI ) 

00  1  3  5  J  *  1 . K 

Ir(SCI,J)*LT  .SMIN)SMIN*S(  I »  J ) 

135  CONTINUE 

S  C  7  »  1  )  *  S  M  I  N 

REOISPLAY  SCALE  VALUES  -  -  RETURN  TO  PREVIOUS  SUBMENU 

00  1<*0  1*1  ,  N  F  ♦  1 
I  K  »  I 

I  F (  I  .GT  *NF)IK  =  7 
I L* ( I -1 )* 34  2 
<«LEVCIK) 

NCH«  K$1 2*7 

6NC00eCNCM.901.IN)FACTPCX<).(SCIK.J).J*l.K) 

IN2«XNC1SNCH)//EL<//9LR//5L<//BIR 

CALL  SPGSPUT.CHARSCNVXC»IN2(1:67)»XL»S) 

14C  CONTINUE 
GO  TO  70 

choice  *  2  ?  --  change  a  scale  value 

<.0  CONTINUE 

IFC ANS.NE. '2 ')GC  TO  50 

ERASE  PREVIOUS  SUB-MENU 

00  2  10  I  *  2  C  ,  23 

I  F(  I  ♦  EC ♦ 22 )G0  TO  210 

Call  SKGSEKASE.LXNECNVXG.IiI) 

210  CONTINUE 

IN*'SC*U  A,  L«vel  2:  C0CE*A2 

IN2*INC1  :3E)//'Scal»  C,  Uv«l  3  :  C0CE=C3 
call  SKGsPLT_CHAQSCNVlC.:N2Ci:t6).29.5) 
lN='Scale  e,  all  L*v*ls:  COCE*B 
IN2*IN<1 :3E)// 'Seal*  0 :  C  0  C  E  =  0  ' 

Call  SMGSPLT.CKA«SCNVIS.!N2Ci:66).21*5) 

PROMPT  FOR  "CODE" 

220  CONTINUE 

CALL  SHGiPLT.CmaRSCNVIO . CODE  -  <C?>  to  E*it:  ',22 
Call  smgsreao.stringcnaio.x.ni.  ,3,,,  •  n c  ,  ,n/:o) 


,  5  ) 


6G 


c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 


c 

c 

c 


<CR>  ?  --  GO  2-iCK  TO  Previous  *£NU 

IF(nC.EC.O)GO  TC  70 

IS  "  C  C  0  E  M  SYNTAX  CORRECT  ? 

IF(nC.GT.2)GC  TC  2?0 
00  230  I  *  1  •  N  F ♦ 1 
I  K  *  I 

IF(I.GT.NP)U*7 
I  L  *  C  I- 1 ) *  3 ♦ 2 

IF(XNl(X:X).EC.FACTaCIlC))GC  TO  240 
230  CONTINUE 
GO  TO  270 
240  CONTINUE 
K=L  EV< IR  ) 

XF(NC.EQ.X)GO  TC  280 
00  2  50  J*1,K 
JR*  J 

XF(XNX<2:2).EO.LEV£l(J))GO  TC  2  3  C 
250  CONTINUE 

H  C  C  0  E "  SYNTAX  is  BAO  —  SENO  MESSAGE  ANO  p  Q  C  M  P  T  AGAIN 

270  CONTINUE 
CALL  BEE? 

CALL  SHG1ERASE.L  INECNVIO  ,  23  .  1  ) 

GO  TO  220 

"CCOEM  SYNTAX  IS  CORRECT  -  -  PROMPT  FOR  A  NEW  SCALE  VALUE 
280  CONTINUE 

call  SMG*PLT_CHARS<NVIC,  #Ent«r  Ntui  Seal#  Valu*:  ',  2  2  ,  40  ) 
CALL  SwGJREaD_STR:nG(NRI0,In1,,8,,,,mC,,NVI0) 

<CR>  ?  —  GO  SACK  TC  PREVIOUS  MENU 

IFO-C.EC.03GC  TC  70 

0  EC  00  E  NEW  SCALE  VALUE 

0  0  2  75  1  *  1  ,MC 

IFCINICI :i).EO.  '  )  G  0  TO  285 

275  CONTINUE 

OEC30S(NCiS04vXNX(X:nC))XQFLT 

OFLT*IOFLT 
GO  TO  295 
285  CONTINUE 

OECOOECmC,S03,IM(1:mC))OFLT 
295  CONTINUE 

IFCNC.EQ.2)G0  TC  300 

SET  SCALE  TO  NEW  VALUE 

00  290  J*  1  ,  K 
SCIK,  J)*OFLT 
290  CONTINUE 
GO  TO  310 
300  CONTINUE 
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SCI*. JK)»OFLT 
310  CONTINUE 
C 

C  s  £C  I  SPLAT  KALE  VALUES  --  LOCP  3AC'  ^CC  i^OT^E?  "CDDEH 

c 

NCh=*£12*7 

£NC00E<nCh#901.IN)PACTR(I*).(S(:k,J)iJ*1.K) 

IN2«IN(X:nCh)//5L*//BL*//5L*//;l* 

call  SMG*PLT^C^A»S( NVIC, I%2 ( 1 : 6  7) • IL  t ‘ ) 

CALL  SMG*ES ASE.L  INE(NVI0. 23 . 1 ) 

GO  TO  220 
C 

C  ChCICE  *  3  ?  --  SET  CONSTRAINTS  TC  DEFAULTS 

C 

50  CONTINUE 

IFCANS.NE. *3*)GC  TO  60 

c 

c  ERASE  PREVIOUS  SUB-MENU  --  DISPLAY  Sew  SL3-MENU 

C 

00  1  65  I  *  2  C  •  2  3 

IFCI .EC.22)GO  TC  165 

CALL  SMGSEC ASE.L INECNVIO , I t 1 ) 

165  CONTINUE 

I  N  *  *  0  -  WILL  NOT  Constrain  tN  Scale  Value' 

CALL  S*GSPLT_CNAftS<NVXO. INC1 :*C  >. 2C • 5) 

I N »  *  1  -  WILL  Constrain  tFe  Scale  Value* 

CALL  SPGSPLT,CHARS(NVIC. INC  1 136) .21 .5) 

IN* 'Enter  default  for  all  Constraints  CO  or  1  >  : 

C 

C  PROMPT  FOR  OEFAULT  VALUE  OF  CONSTRAINTS 

C 

170  CONTINUE 

CALL  SMGJ  PL  T.CMARSCNVIC. IN  (1:40.22.5) 

CALL  SMGSR:A0_$TRING<NKIC,anS.,1.,,.sC..NVIC> 

C 

C  <CP>  ?  —  GO  SACK  TO  PREVIOUS  SUE-MENU 

C 

IF(NC.EC.O)GC  TC  70 
C 

C  IS  OEFAULT  VALLE  VALID  (0  CR  1)  ? 

C 

I  F< ANS. EO. '0  * . CR  .  AnS. EC .  *1  * )G0  TC  180 
C 

C  8A0  ANSWER  -  SENO  MESSAGE  ANO  AS*  AGAIN 

C 

CALL  BEEP 

CALL  SMG*ERASE_LINF(NVI0.23.1) 

GO  TO  170 
C 

C  SET  CONSTRAINTS  TC  DEFAULT  VALUE  --  REDISPLAY  CONSTRAINTS 

C 

190  CONTINUE 
I OFL  T  =  0 

IF(ANS.EQ.  *1  *)ICFLT*1 
DO  190  I  *  1  ,MF 
OD  190  J  *  1  .ML 
ISC(I,J)*ICcLT 
190  CONTINUE 

0  0  2  0  0  I  *  1 . N  F ♦ 1 

1**1 
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IF<I.GT.MF)I**7 
2L*C  X-l  3*30 

^LEVCIO 
NCH*  KO 1  2  ♦  7 

ENC30E<NCMf902.lN)<XSCCI*.J)tJ»ltK) 

lN2«lN(i:NCrt)//BLK//aLR//3LPC//eLPC 

CALL  SHGtPL  T_CH  ARSCNVIC  ,  IN2C  1  .*6  7)  ,  11  +  1  ,  5) 

200  CONTINUE 
GO  TC  70 
C 

c  choice  =  a  *>M  --  change  a  constraint 
c 

60  CONTINUE 

IFCANS.NE. *a')GO  TO  90 

c 

C  ERASE  PREVIOUS  SUB-HENU  --  PRCHPT  FCR  "CCOE" 

c 

00  3  1  5  I  *  2  C  •  2  3 
I F( I . EC . 22  )G0  TC  315 

CALL  spgsefase.linecnvic.i.i) 

315  CONTINUE 

In*  ‘Constr .  A,  Laval  2 •  C0CE*A2 

IN2* In( 1 :  A  C )/  /  ‘Constr.  C,  Ltvtl  3:  C  CO  C  *C  3 

Call  SHGJPLT_Char$(nviC,IN2C1:70),20,5) 

In*  ‘Constr.  3,  all  Lavals:  COCE*B 

IN2* INC  1 : AC )// 'Constr .  0:  CC0E*0 

CALL  SHGSPLT_CHARS(NVIC,IN2C1.*70),21,5) 

c 

C  PRCHPT  FCR  '*  C  0  C  E  M 

C 

320  CONTINUE 

Call  SPG*PIT_CMARS(NVI C, 'Entar  COOE  -  <CR>  to  Exit:  ',23,5) 
CALL  SMG1REAO_$TRING(NKIOiIN1,,3,,,,NC,,NVI0) 

C 

C  <  C  R  >  ?  —  GO  eACK  to  PREVIOUS  SUB-MENU 

C 

IFCNC.EC.O)GO  TC  70 
C 

C  1$  M  C  0  C  E  M  SYNTAX  CORRECT  ? 

C 

IF(NC*GT .2)GC  TC  370 
00  3  30  1  =  1  »  N  F  ♦  1 
I  K  *  I 

I F (  I ♦ GT • NF ) I K  *  7 
I  L  *  (  I  -  1  )  $  3  4  2 

IFCINKI  :  1  )  .  EQ.F  ACTRC IO  )GC  TO  3A0 
330  CONTINUE 
GO  TO  370 
3  A  o  continue 

K=LEV(IK) 

IFCNC-EC. 1  )G0  TC  380 
00  350  J=1,K 
JK*  J 

IFCIN1C2:2).E0.LEVEL(J))G0  TO  375 
350  CONTINUE 
C 

C  "  C  0  0  E  "  SYNTAX  IS  BAO  --  SENO  MESSAGE  ANO  ASK  AGAIN 

r 

370  CONTINUE 
CALL  3EEP 
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CALL  SMGsERASE.il  NECNVIO, 22.1) 

GO  TO  220 
C 

C  "CODE"  SYNTAX  IS  CORRECT  --  FLIP  CLCP  CONSTRAINT  vALU 

275  CONTINUE 

XSCCIK»JK)*1-XSCCIK«JK) 

GO  TO  400 
380  CONTINUE 

00  390  J=1,K 
XSCCXK» J)>1-XSCCXK» J) 

390  CONTINUE 

c 

C  REOISPLAT  CONSTRAINTS  *  LOOP  BACK  F  C  R  ANCTm£R  "CCCEm 

c 

400  continue 

NCH  =  XC 1 2*7 

E  NCO  0  E ( NC  M  »  9  0  2  # IN)(ISCCI*  ,  J  )  »  J  ■  1 »  K  ) 

IN2* INC  1 :NCH)//fiLK//BLK//BlX//5lK 

CALL  SPGSPLT.ChARSCNVIC# IN2Ci:67) ,IL*1 ,5) 

CALL  SMG*ERASE.LINECNVI0,23, 1) 

GO  TO  220 
C 

C  LOOP  SACK  TO  PREVIOUS  SUS-MENU 

c 

70  CONTINUE 

00  BO  1  =  20,  23 

IF( I. EC. 22) GO  TC  80 

CALL  SMGSEfiASE.L!NECNVIC,I,l) 

00  CONTINUE 
GO  TO  20 
C 

C  BAG  ANSWER  -  S  E  N  C  MESSAGE  ANC  PRCMPy  aCaJs 

C 

90  CONTINUE 
CALL  BEEP 

CALL  SPGSESASE.LXNECNVX0«23«1) 

GO  TO  35 
C 

c  OATA  MQQ6L  WAS  NOT  SELECTEC  -  SEND  M  E  S  S  AG  E  A  NO  EXIT 

C 

490  CONTINUE 
CALL  BEEP 

IN*  'No  Oat;  Model  Selected' 

CALL  S^GJPLT,CMA?SCNVIC,INC1:22),1C,2C) 

IN*'See  Option  1  in  Main  Menu' 

CALL  SMGfPLT_ChA3SCNVIC,lNCi:25),l2,30) 

CALL  SMG*SET_CURSQR_ABSCNVI0,ie,30) 

CALL  SMGJREAQ^STRINGCNKIO.ANS, 

X  'Press  any  KET  to  Return' , 1, ,, ,NC , ,NVIO) 

C 

C  EXIT  TC  MAIN  HENU 

C 

500  CONTINUE 
RETURN 

900  FORMATC  '  Level  ',11) 

901  FCRMATC  '  SC  '  ,  A1  f  '  )  '.5F12.2) 

90  2  FORMATC  'Corstr  .  ',5112) 

903  FORMATCF) 

904  FORMATC I  ) 

ENC 
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o  o  o 


SUBROUTINE  RUN 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


This  RCUTI^e  PERFORMS  the  ITERATIONS  FOR  FINDING  T  M  E  OPTIMAL 
CHISC  FOR  TMS  MCOEL  SELECTEO. 

TME  STEPS  incluce: 

1)  ENTER  •ITERATIONS  (CEFAULT*1) 

2)  ENTER  MAX  »ST£PS  (0EFAULT*20) 

3)  COMPUTE  C  MATRIX  (USING  INITIAL  SCALE  VALUES) 

A)  COMPUTE  INITIAL  CHISC  ANQ  WEIGHTS 

5)  COMPUTE  GRADIENTS  (FOR  EVERT  LEVEL  OF  EACH  FACTOR) 

6)  COMPUTE  "TEST"  SCALE  VALUES 

7)  COMPUTE  NEW  C  MATRIX  (USING  "TEST"  SCALE  VALUES) 

8)  COMPUTE  NEW  CMISC  AND  WEIGHTS 

9)  COMPARE  NEW  CMISQ  WITH  PREVIOUS  CMISO 
10)  ADJLST  STEPSIIE  -  GO  TO  STEF  6 


THIS  routine  CALLS  3  SUBROUTINES 

1)  CDMPC  -  COMPUTES  C  matrix 

2)  COmpw  -  COMPUTES  WEIGMTS  anC  CMISC 

3)  CDMPG  -  COMPUTES  THE  GRA0IEKT 

CCMPW  CALLS  MLINEQ  -  MATRIX  INVERSION  FROM  ALPMATECM  LIBRARY 
CQMPG  CALLS  COMPCO  -  COMPUTES  The  PARTIAL  CERIVATIVE  OF  C  MATRIC 


COMMON 

COMMON 

COMMON 

COMMON 

COMMON 

COMMON 


/UNITS/  NVID.NXID.LUNl.IOC.INFIL 

/  P  A  S  A  M  /  NEtNl»N2»NNtNV,NW»MF|ML*NF,LEV(8) .  F  A  C  T  R  (  8  ) 
/FLAGS/  NDFLG.N2FLG.NNFLG 

/RAW/  0AT1(30),CAT2(250),CA7(300),S(B,5).I$C(8,5). 

ICl (3Q»6)»I02(250.6) .10(300*6) »  T ( 5  » 5  ) 

/  R  E  C  R /  T(250).C(250,27),W(27),ISV(27),CMISD,PCMISC 
/RUKRES/  NITER, NSTEPS.N9AC.MSTEPS.SSIE 


DIMENSION  GRAO(9,5),TEM(B,5) 


CMARACTER^l  an$,factr 
CHARACTER***)  INFIL 
CMARACTER^EO  IN 


OaTa  mxSTEPS.mxITER/20,20/ 

OPEN(U  NIT  -  1 1  .NAME*  '  0  U  T • OAT  * ,TY  PE  * 'NEW ') 
CALL  SMGJERASE-0ISPLAY(NVIC) 

WAS  OATA  MCOEL  SELECTEO  ? 

IF(MDFLG.EC.O)GC  TO  *10 


WERE  ANY  REGRESSION  VARIA3LES  SELECTEC 

IF(NV.EQ.0)G0  TC  *20 

PROMPT  FOR  «ITERATICNS  (DEFAULT*!) 


NITER*1 

CALL  SMGtPLT_CHARS(NVlC,#Ent»r  «Ittr*tions5  ' ,  10,30 
CALL  SMGSREAO-STRING(NMO,IN,,3,,,,NC,,NVIC) 
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<CP> 


JET  TC  DEFAULT 


I F C  NC . E 0 . 0 ) GO  TC  60 
0EC00E<NC,  9  0  0  , INC  1 :NC))NI T£R 

IF(N1TER.6T.mxITER>MTER«mxXTEK 
PROMPT  FOR  MAX  *  S  T  E  P  S  (CEFAULT=20> 

CONTINUE 

msteps*mxsteps 

CALL  SMG»PLT^CHARS(NVIO, *Ent«r  Ma*  -Steps:  ',12.30) 
CALL  SMGlREA0_STRINGCNKI0,lN,t3,,,,NC,,NVIC) 

<CR>  --  SET  TC  OEFAULT 

IFCNC. EC.O)GO  TC  70 

OECOOECNC ,900, IN<1 :NC))MSTEPS 

IFCHSTEPS.GT.MXSTEPS)MSTEPS*MXSTEPS 

SAVE  CHISO  ANO  SCALE  VALUES 

CONTINUE 

CALL  SMG»ERASE.CISPLAT(NVIC) 

PCHIS0*CHISC 
00  80  I  «  1  ,  K  F 
00  80  J*1 , y L 
TEM<I,J)«SCI, J) 

TCI,  J)*0.0 
CONTINUE 

ORAw  DISPLAY  TC  SHOW  USER  (CURING  ITERATIONS) 

1)  ITERATICN 

2)  ELAPSEC  TIME 

3)  PREVIOUS  CmISO 
a)  CURRENT  CHISO 

CALL  SFG SO* A W_LINECNVI 0,8.24,8,57) 

CALL  SPG*OR AW_L I NE (NVIC, 1 1 , 2* • 1 1 , 57 ) 

CALL  SMG»ORAW_LlNE(NVlC.lA,2A,l<,t57) 

CALL  SMGSORAW^LINECNVIC, 8, 24,14,24) 

CALL  SKG»0RAW_LINECNVIC,8,57,14,57) 

CALL  SMG*PLT_CPARS(NVIC, 'Iteration:  of', 9, 20) 

CALL  SMGJPLT_CMARS(NVlO,'ElciDS«d  Time:', 10, 28) 

CALL  SMGIPLT^CHARSCNVIC,  'Previous  < H  I  $ C :  '  , 1 2  ,  2 5  ) 
CALL  SMG*PLT_CHARS(NVIC,  'Current  CFISC:',12,2S) 

CALL  SMG*PLT_CHARSCNVIC,  '  O', 9, 38) 

ENC00EC2 , 9  C 1 , In) NITER 

CALL  SMG*PLT-CHARS(NVI0,IN(1:2),9,46) 

CALL  SMGiPlT,CHARSCNVlC,'  0200',  10, 43) 
ENC00EC12,S02,IN)PCHISC 

CALL  SMG»PLT.CHARSCNV:C,lN<i:i2),12,43) 

CURR J=0 . 0 

ENC00EC1 2,902 , IN)CURRJ 

CALL  SFG»PLT.CMARSCNVIC,IN<1:12),12,42) 

CALL  Lie*OATCICN,,NTICK) 


3EGIN  LOCP  TC  ZC  AN  ITERATION 


C  UPDATE  ITERATION*  On  CIS^LAY 

C 

c 

DO  200  ITEG*1, NITER 
ENCOOEC2,9C1,IN)ITER 

caul  Sf*c  tPLT.CHARSC  NVIC.  INC  1  :  2)  •  9  •  2  8  ) 
iters*iter 
c 

C  COMPUTE  C  MATRIX  (USING  CURRENT  SCALE  VALUES) 

C 

CALL  CCMPCCO) 

C 

C  CHECK  C  MATRIX  FOR  A  COLUMN  OF  ZERCES 

C 

00  1  30  J *  1 ,  N V 

I  2  S  *  J 
SUM*0.0 
00  120  1*1, NE 
SUM  *  SUM  ♦ C ( I , J) 

120  CONTINUE 
C 

C  IS  COLUMN  ALL  ZEROES  ? 

C 

IF(SUM.EQ.O.O)GC  TO  400 
130  CONTINUE 
C 

C  COMPUTE  THE  WEIGHTS  ANC  CURRENT  CMISC 

C 

CALL  CCMPW(CURRJ) 

C 

C  COMPUTE  THE  GRACIENTS 

C 

Call  CCMPGCGRAC) 

c 

c  INITIALIZE  e  0  r  LINE  SEARCH 

c 

NSTE  PS- 1 
N 6 A  0  *0 
SS2E*1.Q 

c 

c 

C  BEGIN  LOOP  ON  LINE  SEARCH 

C 

C 

100  CONTINUE 

00  10  1*1,  MF 

00  10  J*  1  ,ML 
C 

C  IS  VARIABLE  CONSTRAINEO  ?  --  IF  YES,  SET  GRADIENT  TO  ZERC 

C 

IFCISCCI ,  J  )  •  E  Q  • 1)GRA0(I,J)*0.0 
C 

C  COMPUTE  "TEST"  SCALE  VALUES 

C 

T(I,J)*SCI,J)*GRA0CI,J)*SS2E 
10  CONTINUE 
C 

C  COMPUTE  NEW  c  MATRIX  (USING  "TEST"  SCALE  VALUES) 

C 

CALL  CCMPC(l) 
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c 

C  COMPUTE  NEW  WEIGHTS  anC  NEW  ChISC 

C 

CALL  CC^PW(XNEWJ) 

c 

C  COMPARE  CURRENT  ChISQ  WITH  NEW  C  H I  5  C 

C 

IFCXNEWJ.LT .CURR J)GO  TC  20 
C 

C  NEW  CHISQ  NOT  SETTER  THAN  CURRENT  ChISC 

C  IF  »STEPS  >  i:  WE  HAVE  F3UNC  OPTIUH  ChISO 

c 

ifcnsteps.gt  •  nco  to  30 
c 

C  CUT  STEP  SIZE  in  half  --  Check  max  •STEPS 

c 

SSZE*SSZE/2  .  0 
NBA0*NBA0*1 

IFCNBAO.LE .HSTEPS)GC  TC  IOC 
GO  TO  50 

c 

C  new  CHISC  BETTER  Than  CURRENT  CHISC 

C  DOUBLE  STEP  SIZE  --  UPOATE  CURRENT  ChISC  --  ChECk  hax  «STEP 

C 

20  CONTINUE 

S  S  Z  E  *  S  S  Z  E  *  2  .  0 
CUR  R J«XNEUj 
NSTEPS=NSTEPS*1 
IFCNSTEPS.LE .hSTEPS)GO  TC  ICO 
GO  TO  50 
C 

C  OPTIMUH  CHISC  FCUNO  --  BACKTRACK  1  STEP  TO  OPTI“L'u 

C  "TEST"  SCALE  VALUES  ANC  C 0 R R E S 2 C N 0 1 nG  -EIGHTS 

C 

30  CONTINUE 

SSZE«SSZE/2  .  0 
00  WO  I  *  1  *  N  F 

K*lEV(I) 

00  WO  J* 1  *  K 

T(ItJ)*S(I»J)*GRAO(I»J)*$SZE 
WO  CONTINUE 

CALL  CCHPC(l) 

CALL  CCHPWCCURRJ) 

C 

C  SET  SCALE  VALUES  TO  OPTIMUM  "TEST”  SCALE  VALUES  FOUND 

C 

50  CONTINUE 

00  170  I*1,NF*1 
I  K  *  I 

IFCI.GT.NF)IK»7 

K=LEV(IK) 

00  1  70  J  *  1  *  K 
SCIK,  J)«T<IK»J) 

T  (IK  * J)*0.0 
170  CONTINUE 
C 

C  UPDATE  ELAPSED  time  ANC  CURRENT  ChISC  On  SCREEN  DISPLAY 

C 

CALL  LIB*Oay(ICN,,ITICK) 

IET«(ITICK-NTICK)/100 
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I  M  *  I  E  T  /  6  0 

is»iET-:*#eo 

EnC006C5»9C2*IN)IM,  IS 

CALL  SHGIPLT.C^ARSCNVIC«:nC1:5)»10»43) 

ENCaOE<12,$02,IOCURPJ 

CALL  SMGIPLT.CmaRSCNVIC, IN  Cl :12),  12 ,  *2) 

C 

C  00  another  ITERATION 

c 

200  CONTINUE 

c 

c 

C  E  NC  OF  ITERATIONS  —  ADJUST  COUNTS 

c 

c 

NITER«ITER$ 

IF(nBAC*GT.mSTEPS)nBaO=hSTEPS 

IF(NSTEPS.C-T.HSTEPS)NSTEPS*mSTEPS 

c 

C  RESTORE  SCALE  VALUES  TC  INITIAL  CONTENTS 

C  SET  "TEST1*  SCALE  VALUES  TO  OPTIMUM  VALUES  CF  LAST  ITERATION 

C  SET  CURRENT  CHISO  TC  OPTIMUM  VALUE  0^  LAST  ITERATION 

C 

210  CONTINUE 

CHI SQ*CURR J 
00  110  I  *  1  *  M F 

00  110  J  *  1  •  ML 
TCI, J)*S(I  ,  J) 

SCI  ,  J)*TEMCI  .  J) 

110  CONTINUE 
GO  TO  430 
C 

C  a  COLUMN  OF  ZEROES  WAS  cOUNC  IS  THE  C  MATRIX 

c  this  will  cause  the  matrix  inversion  program  tc  blow  up 

C  i END  MESSACE  ANC  EXIT 

c 

<*00  CONTINUE 

CALL  SMGlERASE.CISPLAYCNVIC) 
call  SEEP 
NITERsITERS-  1 

IN*  'The  data  fcr  a  variablt  is  all  :trou  ' 
call  SMGSPLT.CHARSCNVIO, INC  1 : 3  7 ), 1C , 20) 
lN*'Please  Chang#  the  data  or  th#  variable' 

CALL  SMG» PL T. CMARSCNV 10,1  NCI :  38), 12,20) 

IN*  'Iteration:  variable:' 

Call  SMG*plT_ChaRSCnvIC,IncI:35>, 14,20) 

ENC00EC2.9C1 , IN)ITE*S 

CALL  SMG*PLT.CHARSCNVIC,INC1:2),14,30) 

ENC00EC2  »9C1 , IN)  I  Z  S 

CALL  S MG  SPLT_CMARS(NVIC,lNCi:2),  14,55) 

CALL  SMGiSET_CURSOR.ABSCNVIO,  20, 27) 

CALL  smg*reao_stringcn*io,ans. 

x  'Press  any  KEY  to  Returr  '  f 1  ,  , ,  ,  K  C  »  *  N  V  I  0  ) 

GO  TC  210 
C 

C  NO  Data  MCCEL  SELECTED  -  SENO  MESSAGE  a  no  EXIT 

c 

<►10  CONTINUE 
Call  seep 

In* 'No  0  a  t  a  Model  Selected' 
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CALL  SKGSPLT_C^A5S(NV:C,lN(i:22),iC,30) 

I N  *  *  S • e  Oct  ion  1  in  M?in  M  «  n  u  ' 

CALL  SMG*PLT_ChARS(NVIC,IN(1:25),12,3C) 

CALL  SMG»SET_CLRSCR_A3S(NVI0,16,30) 

Call  SKG*REAO_STRING(NRIO,ans, 

X  'Priss  iny  RET  to  *• t urn  *  ,  1  •  •  •  • K C • • N V  I  0  ) 

GO  TO  <*3  0 

NO  REGRESSION  VARIABLES  SELECTED  -  SEND  MESSAGE  ANC  EXIT 

<*20  CONTINUE 
CALL  3EEP 

IN*  * N o  R«gr»$$icn  Variables  Selected* 
call  SHGJPLT.CHARSCNVIO, INC  1 : 32) * IC  ♦  3C  ) 
lN**$ee  Option  3  in  Main  Menu* 

CALL  SPGSPLT_ChaRS(NVIC*IN(1::5),  12,30 
CALL  SmG*SET_CL'RS0R_a9S(NVIC. 16*30) 

CALL  SMGJREAO.STRINGCNRIO,ANS, 

X  'Press  iny  RET  to  Return'*l*,**NCt*NVlO) 

EXIT  TC  MAIN  MENU 

a  3  0  continue 

RETURN 

900  FORMATCI) 

901  F0RMATCI2) 

902  F0RMATCE12.6) 

903  FORMAT (12**:  '*12) 

ENC 

SUBROUTINE  COMPCCIFT) 


COMPUTES  C  MATRIX  BASED  ON  THE  VARIABLES  SELECT EO  AND 
SCALE  VALUES. 

I  F  T  =  0  --  USE  SCALE  VALUES  TC  COMPUTE  C 
I  F  T  s  I  --  USE  "TEST"  SCALE  VALUES  TO  CC-PuTE  C 

N2FLG*I ,  N  N  F  L  G  *  0  --  GOING  A  2-wAY  ANALYSIS 
N2FLG*0.NNFLG=1  -  -  DOING  A  N-UAY  ANALYSIS 


COMMON 

COMMON 

COMMON 

COMMON 

X 

COMMON 

COMMON 


/UNITS/  NV  I  D  ,  NR  10  * LUNl  ,  I  CC  ,  I NF  I  L 

/  P  A  fi  A  M  /  NE*Nl,N2*NN,NV,NW,MF,ML*Nc,LEV(B),PACTR(3) 
/flags/  N0FLG*N2FLG*NNFLG 

/RAW/  OAT  1(3Q)*0AT2(250)*0AT (3Q0)*S(8,5)» ISCC3  *5) * 
101(30, 6)  ,  I  02(2  50 , 6), 10(300*6). T(8. 5) 

/  R  E  C  R /  T(250),C(250,27),W(27),ISV(27),CHISC,PCMIS0 
/RUN  RES/  NITER, NSTEPS,NBAC,mSTERS,SSZE 


OIMENSION  S  P ( 6 ) 


CHARACTERS  FACTR 
CHARACTERS©  INFIL 


00  200  11*1, NE 

INITIALIZE  C  matrix  -  Mix  ANC  min 


00  1  60  I  *  1  ,  NV 
C(II,I)*O.Q 


160  CONTINUE 
ft  M  A  X  =  0 . 0 

ftMlN*  1 . 0  E  ♦  1  0 

c 

c  FIND  THE  SCALE  (Cft  TEST)  VALUES  FOft  ThE  VARIOUS  FACTORS 

C  AT  THE  LEVEL  INCICATED  3Y  ThE  EXPERIMENT  (II) 

C 

DO  190  I  *  1  #  N F 
SP< I >*G.O 
C 

C  GET  THE  LEVEL  (IX)  FOft  THIS  FACTOR  (I)  FDR  EXPERIMENT  (II) 

C 

I  X* IOCI I . I ) 

XFCN2FLC.5C. l>XXsXD2CIItI> 

IF(IX.EC.0)G0  TO  190 
IF( IFT . EC. 1 >G0  TO  170 
C 

C  SET  TO  THE  SCALE  VALUE  FOR  FACTOR  "I",  LEVEL  MIX" 

C  CALCULATE  MX  AND  MIN 

C 

SP(I)*S(I, lx) 

IF(S(I,IX).GT.R“AX)RMAX=S(I,IX) 

IF(S(I,IX).LT.RMIN)RMIN*S(I,!X) 

GO  TO  190 
C 

C  SET  TO  THE  "TEST”  SCALE  VALUE  FOR  FACTOR  "I”*  LEVEL  "IX” 

C  CALCULATE  MX  AND  MIN 

C 

170  CONTINUE 

SP(I)*T(I , IX) 

IF(T(I,IX).GT.RKAX>RMAX*T<I#IX) 

IF(TCI.IX>.LT.RMN>RHlN*T(IflX> 

190  continue 
c 
c 

C  GENERATE  ThE  C  MATRIX 

C 

C 

I  w  *  0 
I  V*  0 

c 

C  1-WAY  COMBINATIONS 

C 

00  100  1*1, NF 
I  V* I  V ♦  1 

c 

C  WAS  THIS  VARIABLE  selected  ? 

c 

I  F(  is  VC  I  V) . EO. 0)GD  TO  XOO 
IW* I W ♦ 1 

C(I  I  ,  IW)*SF  ( I ) 

100  CONTINUE 

IF(NF.LT.2)G0  TC  130 
C 

C  2-WAY  COMBINATIONS 

C 

00  110  1*1  #  N F - 1 

00  110  J* I ♦  1  #NF 
I  V* I  V ♦  1 


i  V 


c 


c  WAS  THIS  VARIABLE  SELECTED  ? 

c 

IF(XSVCV).£0.0)GO  TC  110 
I  w  »  I  w  ♦  l 

ccxx>n>)*sF(:)»SP(j) 

110  CONTINUE 

IFCnF.LT. 3)00  TO  130 

c 

C  3-WAY  COMBINATIONS 

c 

00  1  20  1  *  1  t  N  F -  2 

DO  120  J« I* 1 #NF-  1 
00  120  K*  J ♦ 1  *  N F 
I  V* I  V ♦  1 

c 

C  WAS  THIS  VARIABLE  SELECTED  ? 

C 

IF(I$V(IV).EQ.O)GQ  TO  120 
IW*IW41 

CCII  •IW)*SFCI)*SP( J)«SP(K) 

120  CONTINUE 
C 

C  INITIAL  IMPRESSION  --  SCO) 

c 

130  CONTINUE 
I  V*  I  V  ♦  1 

c 

C  WAS  THIS  VARIABLE  SELECTED  ? 

C 

IFCISVCIV).EC.0)G0  TO  140 
IW«  IWM 

C(II»IW)*S(7»1) 

c 

c  range  variable  --  SCR) 

C 

140  CONTINUE 
I  V  *  I  V  ♦  1 

c 

C  WAS  THIS  VARIABLE  SELECTED  ? 

C 

IF( ISVCIV) . EO.O)GO  TO  200 

iw*iw*i 

C  (  I  I  ,  I  W  )  =  RM  A  X -RM  I  N 
200  CONTINUE 
C 

C  RETURN  TO  "RUN” 

C 

RETURN 

ENC 

SUBROUTINE  CCHPWC  XJAY) 

C 

c 

C  this  ROUTINE  CALCULATES  The  WEIGHTS  ANC  ChISG  GIVEN  the 

C  C  MATRIX  AND  THE  Y  MATRIX  (DEPENDENT  VARIABLE) 

C 

c 

COMMON  /UNITS/  N  V  :  D  ,  NX.  :  D  ,  LL  Nl  ,  I  CC  ,  I  NF  I  L 

COMMON  / P  A  R  A  M /  NE.Nl  .NZ.NN.NV.NU #HL.NF,LEV<  5)  t  PACTS  (  0) 
COMMON  /Flags/  N of L G ♦ N2 Fl g , NNF l g 

COMMON  /RAW/  OAT  1 ( 30 ) ,CAT  2  (  2  50  ) , C A T (  30  0  ) . SC  8 . 5 ) , I  SC C 3  ,  5  )  , 
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X 


:C1(3D.6>«!D2C25D.6>'ICC!DD'6>*TC8'5> 

COMMON  /  R  E  C  R  /  Y(:S9)»CC  250  .:  7  )«h(27)»ISVC27),CHlSQiPCHlSC 
COMMON  /SUKRES/  *.  ITER,  \  STEPS. N5flC.KSTEPS.SSZE 

0CU8LE  PRECISICK  C T C ( 2 7 , 2 7 ) . C T Y ( 2 7 ) , w C R K C 2 7 ) . C C NO 
DIMENSION  1MCw(25D>,I?vT<27) 

CmASACTERpI  FACTS 
Charactered  INF  IL 

c 

C  START  REGRESSION  - -  COMPUTE:  (C  tr?nscose  #  C) 

C 

DC  ID  I  *  1  ,KV 
DC  ID  J  *  1  .  K V 
CTCCI . J)«0.0 
ID  CONTINUE 

CO  20  I  *  I  .  K V 
DO  20  JM.Kc 
DO  20  K*1  .  K  V 

C  TC  C  I .  K  )*CTC  C  I  ,K  )^CC J  » I  )*C( J . O 
2  C  CONTINUE 
c 

C  COMPUTE:  (C  trfnsoos*  $  Y) 

C 

DO  30  I  *  I  ,  K  V 
CTY(I)*D.O 
30  CONTINUE 
00  40  I  *  1 
00  40  J  *  1  , k E 

CTY( I )*CTY( I >*C( J. I >*YC J) 

40  continue 

c 

C  C  A  U  U  MATRIX  INVERSION  --  ANS  IN  CTY 

c 

CiUU  MLINEC(27,27.NV,l,CTC.CTY,CCNC.IFVT,wCRK) 

C 

C  UPCATE  WEIGHTS 

C 

00  50  1  *  1  .  KV 
W(  I  )*CTY(I) 

50  CONTINUE 
C 

C  COMPUTE :  CC  *  W) 

C 

00  70  1  *  1  .KE 
YMCwC I )*0.0 
70  CONTINUE 

00  80  I  *  1  ,K E 
00  80  J*  I  ,NV 

YMCW(I)*YMCWC:>*C(I  ,  J  )  *  w ( J ) 

90  CONTINUE 

r 

C  COMPUTE:  (T  •  C  i  w> 

c 

00  90  1  =  1, KE 

YMCWC I ) *  Y  c I ) • Y  M  C  M ( I  ) 

90  CONTINUE 
C 

C  COMPUTE  C  M I  s  C  t  (Y  -  c  t  w)trnnsDOSe  $  ( y  -  C  *  - ) 

C 


x  JA  Y  =  0  .  0 
0  J  10  0  J  *  1 , N E 
ij:t  =  xjayt“C-(  J)?r«Cw(  j) 

100  COM  Inlc 
C 

C  RETURN  TO  *'  R'JNM 

C 

RETURN 
END 

SUBROUTINE  COHPG(GRiO) 

c 
c 

C  COMPUTES  ThE  GRADIENTS 

C 
C 

COmhCN 
.  COMMON 
COMMON 
COMMON 
X 

COMMON 
COMMON 

c 

DIMENSION  GRA0<S»5)*QUMl(27)*0UM4(27t27)i0C M5(27»27)*CUm6(27) 

DIMENSION  (0(250,27) 

C 

C  H  A  R  A  C  T  ER^l  FACTR 
CHARACTERED  IN  F  I  L 
C 

00  40  1*1,  MF 
00  40  J*  1  ,ML 
GRAOCI, J)=C.O 
-0  CONTINUE 

c 

C  COMPUTE  the  GR AC  I  ENT  *  C  R  sv£RY  LEVEL  re  EACH  FACTOR 

C  A  NO  FOR  The  INITIAL  IMPRESSION  -  $(0) 

c 

00  1  00  1  1  =  1  ,  NF4  1 
1  R  *  I  I 

IF< 1 1 . EC . ( NF ♦ 1 ) ) I  K  =  7 
RR*IEV(IK) 

00  100  JJ=1,KK 

c 

C  CALCULATE  c  A  R  T I  a  l  DERIVATIVES  0  f  C  MATRIX  FOR  FACTOR  I<,  LEVEL 

C 

CALL  CCMPCC(CO, IK ,  jj) 

C 

C  COMPUTE:  (Y  trcn$oos«  A  partial  C) 

C 

00  70  1=  1  ,  N V 
0  UM 1 ( I)=0.0 
70  CONTINUE 

00  90  J  *  1  ,  N  E 
00  80  R  *  1  ,  N  V 

0UM1 (R)  =  OUM 1 ( R )«*  Y ( J)*CC( J , *  ) 

80  CONTINUE 

c 

C  COMPUTE:  2  5  (Y  transpose  A  D  r  1  l  cO  C)  c  - 

C 

Duma  =  0 .  o 


/UNITS/  NVlOtNMO,LUNl,ICC,lNFIL 

/PASAM/  NE,Nl,N2,NN,NVt\-,MFtML,NF,LEV(9)fFACTR(?) 
/FLAGS/  N0FLG,N2FLG,NNFLG 

/RAW/  0ATl(30),CAT2(250),0AT(3C0)fS(9,5),:3C(9,5), 
101(30,6), 102(250, 6), 10(300, 6), T ( 3 , 5) 

/ R  E  C  R /  Y(250),C(250,27),-(27),ISV(27),ChIS0,pCmIS; 
/RURRES/  NITER, N$TSFS,N BAG, mSTEPS.SSZE 


J  J 


80 


DC  9 C  J  -  1  ^  v 
OU*i*DL>'A.CuMl(J)-w(J) 

90  CONTINUE 

duma=duma*2.o 

c 

C  COMPUTE:  (C  tr?nsDOS«  i  o?r tial  C) 

C 

00  1  50  I  =  1  • S  V 
DO  15  0  J  =  1  .  N V 
DUM4(  I  •  J  3  *  C  .  0 

150  continue 

00  1  60  1  *1  • N  V 
OC  160  J= 1 , NE 
00  1  60  K*1  ,NV 

ouH4<itn)*cuM4<i,K)4c<jtn«cc(j#^) 

160  CONTINUE 
C 

C  COMPUTE :  <  C  transpose  *  0?rti?l  C  3  ♦ 

C  (C  transpose  s  o t r t i 9 1  C) transpose 

C 

00  2  30  1  *  1  ,NV 
00  2  30  J  *  1  *  N V 
OUM5<  I  »  J  3  *  C  .  0 
230  CONTINUE 

00  240  1*1,  NV 
00  2  40  J*1  ,NV 

0UH5<I,J)*CUM4(I#J)*0UM4(JfI) 

240  CONTINUE 

c 

C  COMPUTE:  k$C<CtsoC)*(Ct$c  CM  3 

C 

00  250  1*1 ,NV 
0UM6  < I  3  *  0  .  G 
250  CONTINUE 

00  2  1  0  J= 1  .  2  7 
00  210  H*1,Z7 

0UM6<O*CUM6(K3*W(J3$DU*5<J,K3 
2  1  0  CONT  INUE 

c 

C  COMPUTE:  w  3  C  (C  t  e  0  C)  «  <C  t  *  d  C)t  2  *  u  \ 

C 

OUM  B  *0  .  C 

00  2  2  0  J  =  1  ,  27 

0UMB=0U.MB*CUM6(J>SW(J) 

220  CONTINUE 
C 

C  COMPUTE  GRfiOIENT  *  C  R  FACTOR  IK,  LEVEL  JJ 

C 

G  R  A  0  < IK  ,  JJ)  =  DUMA-DU*? 

100  CONT INUE 
C 

C  RETURN  TC  " RUN" 

r 

RETURN 

END 

SU3R0UT I NE  COMPCOCCC.Il.Jl) 

c 

c 

C  CALCULATES  TmE  partial  DERIVATIVES  OF  The  C  matrix 

C  WITH  RESPECT  TC  FACTOR  "  I  1 " .  LEVEL  ’*  J  1  " 
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C  OMMON 
COMMON 
COMMON 
COMMON 
X 

COMMON 

COMMON 


/UMTS/  NVIO.NMC.IUNI.ICC.INFII 

/PAR  AM/  N  5  , N 1  , N  2 • N  N , N V , N -  , M  F  , *  L ,  N 1  .l:V(8).F8CTP(e) 
/FLAGS/  NOFLG.MFLG.NNFIG 

/RAW  0ATl(30).0AT2(25C),CAl(300),S(e,5).ISC(8,5), 
ICl(30»6)*IO2(2S0»6)*IC(30C*6)»T(6»5) 

/  R  E  C  R  /  Y(250).C(250.27)..(27),ISv(27),ChISO,PCmISC 
/RUN  RES/  niter, nsteps.n etc, -steps. ssze 


OIMENSION  C0(25C,27),SP(6) 


CHARACTERS  factr 
CHARACTERS*)  :nf:l 


00  2  00  I  1  =  1 , NE 
00  1  60  1  =  1  ,  N  V 
CO(II,I)=Q.O 
160  CONTINUE 
RRMax*0.0 
RMA  X  =  0. 0 
RRMIN=  1  . OE*  10 
R  M I N* 1 . 0  E  ♦  1  0 
X  MA  S*  =  0 . 0 

FIND  The  scale  values  FOR  the  VARIOUS  p  A  C  7  C  R  S  at  The  LEVELS 
INCICATEO  eY  THE  EXPERIMENT  Cl  I) 

00  190  1*1 , NF 
S  PC  I  )  *  0 . 0 

GET  THE  LEVEL  "IX"  p  0  R  FACTOR  "  !  " 

lx* 10(11, I) 

I  F  <  N  2  p  L  G  .  E  C  .  1  )  I  X  *  I  0  2  (  I  I  ,  I  ) 

IS  THIS  the  FACTOR  ANO  level  of  The  PARTIAL  DERIVATIVE  ? 
iFci.EC.n.ANO.ix.eo. jdgc  tc  lec 

NO  --  SET  PARTIAL  DERIVATIVE  TC  SCALE  VALJE  FC?  FACTOR  "II 
LEVEL  MIX”  --  COMPUTE  -IK 

SP(I)=SCI,IX) 

IF(S( I  *  I  X ) • G  T .R-AX  )Rmax  =  S( I , lx) 
IF(SCI,Ix).lt.Rmi;ORmin=SCI,Ix) 

GO  TO  190 

YES  —  SET  PARTIAL  DERIVATIVE  TO  1.0  e C R  PACTCR  M  I  1 "  . 

LEVEL  H  I  X  "  -  -  COMPUTE  max  AND  “IK 

160  CONTINUE 
SP(  I)*1.0 
X  MA  SK  *  1  .  0 

IF(S(I,IX).GT.RRMAX)RRMflX=S(I,!0 

ifcsci<ix).lt.rpmin)rrmin*sc:,:x) 

190  CONTINUE 


GENERATE  THE  PARTIAL  DERIVATIVE  0  p  T  h  E 


MAUI 


c 

c 

I  w  =  0 
I  V*  0 
r 

C  1-WAY  COMBINATIONS 

c 

00  1  00  I  *1  ,NF 
IV«IVM 
r 

C  IS  THIS  VARIABLE  selecteo  ? 

c 

IFCISVCI V). 53.0)00  TO  100 
IW=IW1 

COC  I I , I w )  =  S  p  C I )*  xmaSk 
100  CONTINUE 

ifcsf.lt. noc  tc  130 

c 

C  2-WAY  COMBINATIONS 

c 

00  110  IM.NF-1 
00  1  10  J*I«i*NF 
I  V  *  I  V  ♦  1 

C 

C  IS  THIS  VARIABLE  SELECTEO  ? 

c 

IFC I  SVC  I  V) . EQ .0 )G3  TC  110 
I  W  •  I  V  ♦  1 

COCII#lW)*£PCI)eS?CJ)«XHASK 

no  continue 

IFC.NF.lt.  3)00  TC  130 

c 

C  3  -  WAY  COMBINATIONS 

C 

00  12 0  1  *1  *  N F -  2 
00  1  2  0  J  =  I  ♦  1  • N F -  1 
00  120 
I  V  =  I  V  ♦  1 

C 

C  IS  THIS  variable  selecteo  ? 

c 

I  FC  I  S VC  I  V) . sc. 0 )G0  TC  120 
IW»  IWM 

COCII.Iw)s!PC:>*SPCJ)*SPOO*xma$k 

120  CONTINUE 
C 

c  initial  impression  -  sco> 

c 

1  30  CONTINLE 
I  v=  I  VI 
C 

C  IS  This  variable  selected  ? 

C  IF  YES  --  SET  The  CERIVATIVE 

C  IF  NO  --  SET  THE  OERIVATIVE 

c 

IFCISVCIV).EQ.O)CO  TC  no 
i  w  s :  w  ♦  i 
0  E  3  *  0 . 0 

IFCI1.EC.7)CER=1.0 
CCC II ,  I  W  )  =  C  E  R 


TC  1.0 
TO  0.0 
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c 

c  RANGE  variable  -  S(  R  ) 

1  <  0  continue 

I  v= I v ♦  l 

c 

C  WAS  THIS  VARIABLE  SELECTED  ? 

C  IF  NO  --  SET  THE  DERIVATIVE  TO 

C  IF  YES  --  SET  OESIVATIVE  TC  -I. 

c  CP  h  AX  w  A  S  T  RUE  “  IN  C 

c 

IFC ISVC  X V). EC.O )GG  TC  20C 
IU*IUM 
R  1  *  0  •  G 
R  2  *  0 . 0 

IFC  a RMAX . GE . RHA  x  )a  1  r  1  . 0 
IFC  RRHIN. LE . RHI N  )R2*1 . 0 
C0CXX'XW)*R1-R2 
200  continue 
c 

C  RETURN  TO  M  C  OH  P  G  " 

C 

RETURN 

END 


0  .  0 

C  CP  1  .0  IF  m 
C  TRUE  max 
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SUBROUTINE  ?:S 

c 

r 

w 

C  DISPLAYS  TKE  RESULTS  0  c  THE  I  T E R A T J C N < S  )  AND  LINE  SEARO 

C 

C  SCREEN  I  :  CISPLAYS  Initial  anc  new  SCALE  values 

C  SCREEN  2 :  DISPLAYS  WEIGHTS 

r 

C 

CDH^CN 
COMMON 
COM  ^cn 
C  CHHQN 
X 

c  3  y  m  o  n 

C  C  M  M  Q  N 
C 

Characters  A NS, pact? 

C  H  a R ACTERil  2  BLP  ,  IN2 
CHARACTERS^  vapcm(27  ) 
c^aracterrao  infil 

CmA  R  act  E  85 E  0  IN 
CHA  R  ACTE  PS  2  0  :m 
c 

CiTl  9LK/'  V 

c 

CALL  SHGtERASE.CISPLAY(NVlC) 

C 

C  WAS  CATA  HCOEL  selected  ? 

c 

ipcnofig.ec.ogc  to  200 

c 

C  DISPLAY  SCALE  values  and  "TEST"  SCALE  values 

C 

cc  :  0  1*1,5 

ENCC0c(l2,S08,lN2)I 
J*< 1-1)312*  12 

Call  SPGSPIT.CHASSCNVXC*X.N2«1«J) 

10  CONTINUE 

DO  20  I  *  1  •  N  f • 1 

1*  =  : 

I  c  C  I  ,GT . NF  )  IK  =  7 
Il*<  1-1 >*3*2 

K =  L  E  V( I K  ) 

NCh=K$1 2 ♦ 7 

ENC:0E(NCm,909,IN)FACTRCIX),(S(IX,J),J=1,O 
:Nl*:N(i:NCM)//eLK//BLK//fiLK//5l< 

CALL  SHCsPLT_C«ARS(NVID,IN1(1:67),IL,5) 
ENC00£CNCH,910,XN)(TCIR.J)fJ*lfK) 

Ini  a  In( l  :nCh)//6LX//Blx//BLK//Bln 
CALL  SHG*PUT_CHAR$(NV!C,IN1<1:67).IL*1,5) 

2  C  CONTINUE 

c 

C  0ISDLAT  The  PARAMETERS  FRO*  the  ITERATICN(S) 

c 

CALL  SPGtPLT.CHACSCNVlD*  *«It«r?tiorS:  ',20,5) 

CALL  SPGSPLT.CHARSCNVIC,  '  *S Y#os  :  '  ♦  2  0  ,  27  ) 

Call  Shgsplt_Cmars(NVIC,'(h*«=  ) *,20,38) 

Call  $HG*PLT_CHARSCrjviCt'$t#o  Siz«:  ',20,50 
Call  S^GSPLT.ChaOSCNVIC,  'Current  CFI$C:',21,U) 


/UNITS/  NVI0,N<I0,LUN1, ICC, INFIL 

/PAR  AH/  NE,Nl,N2,NN,NV,NW,MF,HL,NFtLEV(e),eACTR(E) 
/FLAGS/  NOFLG , N2FLG , NNFLG 

/Raw/  QATl(30),CAT2C250),CAT(3C0)tSC9.5), ISCC8, 5), 
101(30,6), I02C250,6),ICC300,6),T(?, 5) 

/  R  E  G  R  /  Y(250),C(250,27),W(27),ISV(27),C-IS:,PCHIS0 
/PUNRES/  NITER, NSTEPS.N8AC, ESTEPS, SSIE 
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C  -  L  L  S^G»Pir_C-iCs(\V10.'Orevicus  CHI5C:', 21.^5) 

ENCDDE(2.9C2»  IN2)  NITER 

CALL  S’'GSPlT_CH£3S(NVXC'XN?<i:2).:C.!7) 

;fcssze.lt.i.o)gc  to  60 
ENCSOE(2.9C2.XK2)NSTEPS 
GD  TD  SO 
60  CONTINUE 

=NC0DE(2  *  9  C  2  » IN  2 )  N  3  A  D 
90  CONTINUE 

CALL  Sf'CSPLT_CHARS<NVlC*XN2(i:2),2C«24) 

EnC0DE(2  »  9  C  2  , IN2)WSTEPS 

CALL  SKG*PLT_CMASS(Nv:OtIN2(i:2),2C,^2) 

6NCOOEa2.SH  *IN2)SSZE 

CALL  S^G*PLT_CuaRS(nVIC*  I  N  2  »  20*  t  <•  ) 

ENCDOEC 10,912. IN2)CmISC 

CALL  S^GSPLT.C^-APSCNVIC,  IN2(  1 :  1  0)  ,  2  1  ,  25  ) 

encode ( 10,912. in: >pcm:s; 

CALL  SPGSPLT_C>‘A9SCNv:C»X’i2<2:iG).21.eO) 

CALL  S^G*DRAw_L INECNVIC.19, 5. 19, 75) 

CALL  SKG*0RAW_LINE(NVIC, 22, 5,22 , 75) 

C 

C  SET  THE  SCALE  VALUES  TC  TnE  -TEST”  SCALE  VALUES  ? 

C 

IN*  #  S • t  Sc«le  Valuts  tc  list  Results  (y/\)?  ' 

CALL  SPGSPLT.CHARS(NVXCtlN(i:4C>.22.5) 

CALL  SPG»REAO.STRINGCNXIO,ANS,,!,,,,NC,,NV:0) 

CALL  S^G»cAASE_L  INc(NVI0,22 , 1 ) 

i  y  e  s  -  0 
c 

C  <CR>  ?  —  DONT  SET  THE  SCALE  VALLES 

C 

IF(NC.6C.0)GC  TC  50 
C 

C  ANSWER  IS  NOT  YES  --  00 NT  SET  SCALE  VALUES 

C 

IF(ANS.Ng.'Y'.AND.ANS.NE.'y')GC  TO  SC 
C 

c 

C  ANSWER  IS  yes  -  -  SET  The  SCALE  VALUES  TO  T  h  £  ‘’TEST"  SCALE 

C 

C  REDISPLAY  The  n  £  *  SCALE  VALUES  AND  Z  E -  0  CUT  T  m  e  "TEST”  S  C  A  l 

C 

C 

I  Y  E  S  *  1 

00  20  I  *  1  ,NF*1 
IK*  I 

I  F (  1  .GT.NF)lKr7 
K*IEV(IK) 

I  L - (  1-1)^342 
NCH  =  K*1 2 ♦ 7 
00  AO  J= 1 , k 
S<  IK t  J)*T(  I  K  ,  J  ) 

T(IK,J)*0.0 
<*0  CONTINUE 

encode (nch , 909 , :n)f  acts( : r  >,( sc : y w  =  1 ,« ) 

I  N 1  *  I N  ( 1 ANGM)//5L'//9Lr//9LY//?L* 

CALL  SPG»PLT_ChARS(NVlC,IM<i:67),lL,5) 

ENCOOE(  NCM,  910  ,  I  NX  7(  I*  ,  J)  ,  J*  1  ,  Y  ) 

INI* IN( 1 :nCh)//?l*//31*//5LK//2L* 

CALL  SKG*PLT_CHAPS(NV:0,lNl(i:‘7),lLa,5) 


vall 

V  A  L 
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30  CONTINUE 

c 

C  PAUSE  FOS  LS6?  TO  PEAO  SC&EEN  1 

r 

SO  continue 

I  N*  'set  ?r#is  ?ny  n  E  Y  for  \  #  *  t  Scr»»n  its' 

CALL  S^Gi?LT_C*A0S(NVlC,lN(i:45).23,I7) 

CALL  SKGi»EA3_ST3lNG(NifI0,ANS,.l....NC.,NVl0) 
call  smgse=ase.c:splaycnvic) 

C 

C  BEGIN  SCREEN  2  CISPLAY  OF  WEIG-TS  ANC  VARIABLE  *33* 

c 

CALL  SPCi05AW.LlNE(NVICf2t5.2t74) 

CALL  SKGsOKAw_lINE(NVIC,1S,5,I9,76) 

CALL  SPGsO&AW.LZNE(NV!Ct22tS»22«76) 

CALL  SHG iGS  AW.L I KECNVIC • 2 . 40 • 1 5 • 40  ) 

CALL  S.*GS0CA-_LINECNV  10,2,41,10,  41) 

IN*  *Var»  i:  J#ight  *5  Variable  Fern  # 

Ini«in(i :34)//#  V  / 1  n  <  i :  3  4  ) 

CALL  SKGSPLT_CMAJ?S<NVIC#INIC::72).1.5) 

C 

C  ENCODE  AND  DISPLAY  WEIGHTS 

C 

I  V  *  0 

00  90  I-l.NU 
ENCDOEO  ,9C0,  IN)  I 
INI*  # 

I  F (  I  S V ( I ) . E  C . C ) G G  TO  65 
I  V*  I  V  ♦  1 

ENCGOE ( 1  2  »  SO  1 • I N1 )w( I  V) 

65  CONTINUE 
I  L  *  I  +  2 
ICI  =5 
I C  2  *  1 1 

IFC  I.lE. U  >GC  TC  70 
IU«IL-14 
ICI *43 
IC2  *49 
70  CONTINUE 

CALL  SKGSPLT.Ch&2S<NVlC»INCi:3)i:L»XCI) 
call  SMGiPLT-CHARSCNVi:,;Nl(i:i2),;L.IC2) 

80  CONTINUE 

c 

C  ENCCOE  1-WAY  COMBINATIONS  CF  VAPIAELE  c0PM 

c 

I  V*  0 

00  100  1*1. Mf 

IV*  I  V ♦ 1 

ENC00EC14,9C3,VARF^(IV))FACTQCI) 

100  CONTINUE 

IF(nF.LT.2)GC  TC  1 3  C 
C 

C  ENCGOE  2-^AY  COMBINATIONS  CF  vapiaelE  cCPu 

C 

00  110  I  *  1 • N F -  1 

00  I  10  J*I ♦ 1 .nf 

I  V  *  I  V  ♦  1 

ENC00E(14,SC4#V£PrH(IV))‘:ACTP(!),cACTC(j) 

1  1  0  CONTINUE 

IF(NF.LT.3)GC  TC  130 


V7 


c 

C  ENCODE  3-wfiT  COMBINATIONS  CF  v:?;  i?lE  cCSm 

c 

CC  120  1*1  .nf-2 
00  1  20  J*I«1»'JF-1 
00  120  K  ~  J  *  1  »  % F 
I v*  I  V ♦  1 

ENC00E(l^,S05,VA?CtaCIV))FACT;(;)iF£CTC(J),F4CTP(O 
120  CONTINUE 

c 

c  enccoe  initial  impression  -  sen 
c 

130  CONTINUE 
IV=IV*1 

ENCC0E<lAfSC6,VARF*<Iv)) 

c 

C  ENCCOE  RANGE  variable  -  S<R) 

c 

I  V* I  V*  1 

encooe<i*,so7,varfm<:v>) 

c 

C  OISPLAY  the  variable  FORMS  just  encoded 

c 

00  1  AO  1*1 t  NW 

I I  *  I  ♦  2 
I  C  *  2  5 

I  F  (  I  .  LE  .  1  A  )  G C  T  :  I  A  5 

I  L  =  I  L  -  1  A 

I  C  *  6  3 

1A5  CONTINUE 

CALL  SFClPLT.O-ARSCNVlCtVAPF^O.Il.rC) 

1  A  0  CONTINUE 

c 

C  DISPLAY  PARA^ETCAS  c  R  0  m  ITERATION (S) 

c 

CALL  SHGSPL  T_Cm  ARSCNVI c •  • • I t #r r t lor s  :  '  .  2  0 , 5  ) 

CALL  SKGSPI T.CHA  RSCNVIC , ‘ • S t tcs : ' , 2  0 , 2  7 ) 

CALL  SKGIPLT.CMARS<NVIC,'CMa*«  ) ',20,39) 

CALL  SMGlPLT^C^ARSCN'VIC  ,  'St®D  S  l  2  e  :  '  ,  2  C  ,  5  A  ) 

CALL  SMGSPLT_CmARS(NVIC,  *'urr*r t  C ^ I S C  :  **21,11) 

CALL  SMGSPLT_CFAPS(NVlC,'Previcus  Cm  I  <  C :  '  ,  2  1  ,  <•  5  ) 
ENC00E(2,9C2,IN2)MTER 

CALL  SMGSPLT_ChaRS(NVIC,In2(1:2),2C,17) 

XFCSSZE.LT. 1.0)G3  TO  160 
ENC30E(2,9C2, IN2 )n$7EPS 
GO  TO  190 
1  6  C  CONTINUE 

ENC00E<2»9C2,In2)NBA0 
190  CONTINUE 

Call  SNG*PIT_Chars<nvic,In2(1:2).2C,20 
cNC00E<2t9C2t:%2)MSTS?S 

CALL  SPGSPlT_C*A5SCNVIC,lN?<::2),2Cf-2> 

5NCOOEC 12  f9 1 2 , in: } ss:s 

CALL  SMG*PLT_Cha?S(NV!C,IN2,20,6A) 

ENCCDE(l0»Sl2tZN2)CNZSC 

CALL  SFGsol  T.Cm  ARSCNVIC. IN2C 1 : 10 ) . 2 1  .  ;s) 

ENCCOE ( 10.91 2 , IN2 )RCh2  SC 

Call  SMG*H  T_C*  a?  SC  nv:  0  ,  JN2C  1  :  l  0  )  .  2  1  ,  t  0  ) 

C 

C  HAS  The  scale  values  BEEN  SEt  yc  T^c  "TEST*1  SCALE  VALUES  ? 
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c 

:ec :  yes. sc. i )cc  to  2 so 

In*  *S#t  S  c  «  1  e  values  tc  Test  Results  (  Y  /  N  )  ? 
Call  SHGSPUT.CHA9SCNVIC.lN(i:40)«23«5) 

Call  S’‘GsaSfi3.STQlNGC’4KlD9ANS»«l"..NC'«’JV!3) 
Call  S^GtEC aSE.LInE(nvIO,22  ,  1  ) 

C 

C  <C5>  ?"  --  3  0  N  T  SET  THE  SCALE  VALLES  TC  THE 

C 

ipcsc.ec.og:  tc  2*0 

c 

C  ANSWE9  is  NC  ?  --  COM  SET  THE  SCALE  VALLES 

C 

r  F  C A SS.NE .  •  Y # . AKC  .  ASS.NE .  'y *  )GC  TO  2  A  C 
C 

C  anS-ER  IS  YES  --  SET  SCALE  VALLES  TC  "TEST" 

C 

OC  230  Z  *  1  *  NF*  1 

:<«i 

I  F  C  I  .GT.NF)IK-7 
<*LEV( IK ) 

00  230  J*1 »K 
SCIK,  J)  =  TCIk  #J) 

TC IK  *  J )*  0 . 0 
230  CONTINLE 
GO  TO  250 
C 
C 

C  COST  SET  THE  SCALE  VALUES  TC  T*-  E  "TEST”  SCALE 

C 

C  RESET  The  VALUE  0  f  CHISG  A  N  Q  R E 0  I S F L a Y  IT 

C 

C 

2  <.0  CONTINUE 

ch: so*?chi s  c 
ENCC0EC10.S12.IS2)CH!SC 

CALL  $PGtPlT.CHAaS(NVlCtIN2(i:iO)t21t2$) 

C 

C  SAVE  THE  RE SULTS  ON  A  FILE  ? 

C 

250  CONTINUE 

IN* 'Save  3#  suits  in  *  F  i  1 1  (Y/N)?  ' 

CALL  SHGSPLT_CHARS(NVIC.INC1:28),23»5) 

CALL  SHGS3EA3^STt5lNG(NKlO*ANS,,ltt,tNC,.NVlO) 
call  SHGSECASE_LINECNVI0,23#1) 
c 

C  <  C  3  >  ?  --  OONT  SAVE  THE  RESULTS 

C 

IF(NC.EO.O)GG  TC  210 
C 

C  ANS-E3  IS  NC  - -  QCNT  SAVE  THE  RESULTS 

C 

Ir ( ANS.NE .  * Y  # . ANC . ANS .NE .  ' )GC  TQ  21C 

C 

C  ANSWER  :s  yes  --  SAVE  The  RESULTS 

C 

C  IS  The  OUTCUT  FILE  ALREADY  OPE  NEC  ? 

C 

I  «=  C  IOC.eC.  1)G3  TC  260 

c 


H9 


test  SCALES 


SCALE  VALLES 


values 


c 


OPEN  T  -  i  CUS 


NT  SET 


=  l  -  G 


N3 


C 

C 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


0  Pc  N  (  UM  T  « t  'J N  1  .  \  i  M  £  =  *  R  5  S  U  L  T  S  .  S  7  c  '  ,  T  T  P  E  *  '  N  E  *  *  ) 
ICC*  1 


WRITE  ThE  RESULTS 

260  CONTINUE 

WRIT  ECLUM  ,  S  1  3)  INF  It 

WRlTE(lUNl#910M.N2#NFfNNtNFt(LSV(!),:*l*NF> 
wai TECLUN1 , SI  5 )N£  #NV ,NW 
WRITECLUN1  ,921) 

I  V  s  o 

00  2  70  I  *  1  ,  NW 
1 F ( I  $ V( I ) • S  C • 1 ) G  C  TO  275 
W  a  I T  E ( L  U  M . 916)1, V  A  P  F  M ( 1) 

GO  TO  270 
275  CONTINUE 
I  V» I V ♦ 1 

WRITECLUNI, 917)1, W(1V),VARFM(I) 

270  CONTINUE 

waiTECLUNl *920) 

CC  2  o 0  1*1,  MF 

WRlTE(LUNl,918)(S(I,J)tJ*l,HL) 

280  CONTINUE 

WR1TECLUN1 , 919)ChISC 
GO  TO  210 

NC  0  A  T  i  HOC  El  SELECTEC  -  SEND  “  5  S  S  A  G  E  A  NO  EXIT 

200  CONTINUE 
CALL  5EEP 

Ins  ‘No  0  fi  t  <  uor«l  Selected* 

CALL  SFG»PLT.CwA3S(NVlC,lN(i:22)tlC#2C) 

IN*  'See  Cot  ion  1  in  Main  ten/ 

CALL  SPGS  PL  T_OASS(NV:CtlN'(i:25),  12,30 
CALL  SPGJSET.ClRS0R^AoSCNV:0,16,30) 

call  smgsreao^str:nG(nkio,ans, 

X  'Press  «  n  y  «.  E  T  to  Return',  1,,*,KC*,NVI0) 

GO  TO  220 

PAUSE  FOR  LSER  TO  READ  SCREEN  2 
210  CONTINUE 

Press  any  KEY  tc  Return  tit' 

call  SKG  splt^Ch  ACSCNVI  C  ,  ivc  1  :  3C  ) ,  23  ,  20 
call  shgsreao_s7r:ng(n*io,ans,,:,,,,nc,,nvic> 

RETURN  TO  MAIN  MENU 

2  2  C  CONTINUE 
RETURN 

900  fCRt:TU3) 

9C1  PCRHAT(E12.6) 

902  C3RMAT(12) 

9  0  3  FOR^ATC  #S(  *  , A  1  ,  * )  '  > 

9  0  <•  FCR-ATC  'SC  ',A1  ,  *)cSC  ',A!  ,  ')  ') 

905  c0RMAT('S<#,A1.')*S<',A1,')9S<',A1.')O 

906  FORMAT  C  'SCO  ') 

9  0  7  FORMAT  (  'SCO  ') 
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903  FQRMATC  '  Level  *.I1) 

90S  FQQaaTC  *S<  ‘  •  A  1  #  *  ) 

910  F3RMATC  'Te«  t  * . 5F 1 2 . 3  ) 

911  FORM  A  T ( E 1 2 . 6 ) 

912  FQRMATCMO.O 

913  F  OR  M  A  T  (  IX*  *cll#N*>*t:  '  *  A  4  0  ) 

914  F  Q  R  H  A  T  (  1  X  ,  ’il-^yj:  '  ,  I  2  .  5  X  ,  ',13.5*.  '•',Il.'“Wfys:  '  , 

X  I  3/1 X , *»pactcrs:  ' .  1 1 . 3  x  »  'Levels! #  •  6  !  2  } 

915  FCR,MAT(lx,'*6<c#ri««#nts:'.I3.5x,'*Varii*bl*s:#,l2.'  of  '.12) 

916  FORHAT(lx#I3,22x,AlO 

917  F0RHAT(1X.I?,4X,£16.8,3X,A14) 

913  FQRMAT< 1 X  #  5  c 14. A ) 

919  FQRMATC/1X,  '  C  rt  I  S  C  :  '.£16.8////) 

920  FORMAT (/lx, *  Sc i 1  *  v? lots') 

921  FQRMATC/IX,  'Van  A-**  Weight  t  $  t  Varwble  for*  ') 

E  NC 


SM 


Program  Name: 

STF10 

Language : 

BASIC 

Machine : 

Compaq  Personal  Computer  (IBM  compatible) 

Purpose : 

This  program  is  a  utility  that  supports  the  data  collection 
effort.  Data  required  to  print  questionnaires  is  entered 
using  this  program. 
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THIS  PROGRAM  GETS  DATA  ABOUT  A  NODE  IN  A  HIERARCHY  AND 
the  LEVELS  OF  THAT  NODE,  And  WRITES  The  DATA  TO  A  file 

PROGRAM-ID.  STF—  1 1?. 

DATE-WRITTEN.  FEBRUARY  1385. 

INSTALLATION.  ALPHOTECH,  INC. 

ACCOUNT.  J 1 87-0 1 . 


1* 

20 
30 

50 
60 
70 
80  1 

30  GOSUB  160  ’ housekeeping 

100  GOSUB  470  ’display  node  screen,  etc 

110  GOSUB  13.30  ’write  or  rewrite  file 

120  GOSUB  1460  ’end  of  job 

130  1 

Determine  drive  quest  l  onna  l  re  file  is/willbe  on  (arid  other  things). 


140 
150  1 

160  CLS  :  LOCATE  8,4  :  PRINT  "STF-10.  ** 

170  LOCATE  10,4  :  PRINT  "This  program  accepts  data  about  a  node, and  writes 

data  to  a  file." 

180  LOCATE  12,4  :  PRINT  “Please  enter  drive  that  file  ls/will  be  on." 

130  LOCATE  12,  50  :  INPUT  "  ",  DRIVE* 

200  IF  NOT  (DRIVE*  *  “A"  OR  DRIVE*  =  “a"  OR  DRIVE*  «  "B "  OR  DRIVE*  *  "b") 
THEN  BEEP  :  PRINT  "Drive  must  be  a  or  b  or  A  or  B.  "  :  GOTO  130 

210  OPTION  BASE  1 
220  DIM  PROMPTS* (12) 

230  DATA  "NODE  INFORMATION" 

240  DATA  "Node  number:" 

250  DATA  "Node  name:" 

'Short  Form:" 

‘Node  Definition:" 

"Number  of  Factors:" 

"Measure  of  Node:" 

"Number  of  Levels:" 

310  DATA  "Level  Def  mit  ions:  " 

320  DATA  "Level" 

330  DATA  ":  Def’n:" 

340  DATA  " Short -Form : " 

350  FOR  I  «  1  TO  12  :  READ  PROMPTS*(I)  :  NEXT  I 
360  DIM  PLOCS ( 1 2, 2) 

370  DATA  1 , 30,  2,  8,  3,  1  0,  4,  9,  6,  4,  3,  2,  1 0,  4,  11,3,  13,2,  15,  2,  15,3,  13,7 

380  FOR  I  *  1  TO  12  :  FOR  J  =  1  TO  2  :  READ  PLOCS  (I.  J)  :  NEXT  J  :  NEXT  I 

390  DIM  RROWS ( 9 ) 

400  DATA  3,4,5,6,7,8,9,10,11 

410  FOR  I  *  1  TO  9  :  READ  RROWS ( I )  :  NEXT  I 

420  SI*  *  STRING* (55, )  :  S2*  «  STRING* ( 10, "-" )  :  S3*  =  ST R I NG* ( 35, " ) 

430  DIM  NODEF M* (2) , NODEDEFN* (3) ,  LEVELDEFN* ( 5, 3 ) ,  SHORT F M* (5,2) 

440  Kl*  =  "quit  ' ♦  CHR* (13)  :  K 2*  *  " ne x  t "+CHRS ( 13) 

450  KEY  1  , K 1  *  :  KEY  2,  K2* 

460  RETURN 


260  DATA 
270  DATA 
280  DATA 
290  DATA 
300  DATA 


that 


470  ’ 

48*  ’  Node  Screen  Subroutine 

49*  ’ 

500  1  The  foliowing  lines  aispl ay  the  screen,  with  prompts. 

510  1 
520  CLS 

530  FOR  1*1  TO  15  :  LOCATE  PLOCS ( I , 1 ) , PlOCS ( I , 3 )  :  PRINT  PROMPTS* 

NEXT  I 


540 

550 

560 

57* 

580 


590 

600 


610 

620 

630 

640 

650 

655 

660 

670 

680 

690 

700 

710 

720 

730 

740 

745 

750 

760 

770 


the  following  lines  get  data  about  the  node 


GO  0  570 
’ get  e>  isting 
*  :  LOCATE  ^.22 
PRINT  SI*  :  LOCATE 


STUFFS 


LOCATE  2,21  :  INPUT  "  **,NODENUMS 

IF  NOT  (LEN (NODENUMS)  *  7) 

THEN  BEEP  :  LOCATE  23,  4  : 

PRINT  "Node  number  must  have  7  digits 
GOSUB  1010 

IF  EXISTING  =  *  THEN  LOCATE  3,22  :  PRINT 
LOCATE  5,22  :  PRINT  S2S  :  LOCATE  6,22 
PRINT  SIS  :  LOCATE  8,22  :  PRINT  SIS 
FOR  I  *  1  TO  9 

LOCATE  RROWS ( 1 ) , 21  :  LINE  INPUT  -  ", 

IF  LEN(STUFFS)  *  0  THEN  GOTO  780 
IF  STUFFS  *  "quit"  THEN  GOTO  1000 
IF  STUFFS  =  "next**  THEN  GOTO  79* 

IF  STUFFS  *  **.  "  THEN  STUFFS  = 

ON  I  GOTO  670,  680,  690,  700,  710, 

NODENAMES  *  STUFFS  ;  GOTO  780 
NODEFMS(l)  *  STUFFS  ;  GOTO  78* 

NODEFMS ( 2 )  =  STUFFS  :  GOTO  780 

NODEDEFNS ( 1 )  *  STUFFS  :  GOTO  780 

NODEDEF NS  <  2 )  =  STUFFS  :  GOTO  7 80 

NODEDEFNS (3)  *  STUFFS  :  GOTO  780 

NF  ACS  =  VAL (STUFFS) 

IF  (NFACS  )  5)  THEN  BEEP  :  LOCATE  23, 10  : 

PRINT  11  number  of  factors  must  be  not 
GOTO  780 

NODEMSREs  *  STUFFS  :  GOTO  780 
NODELVLS  *  VAL (STUFFS) 

IF  (NODELVLS  >  5)  THEN  BEEP  :  LOCATE  23. 10  : 
PRINT  "  number  of  levels  must  not  be  greater 


get  number'  of  node 


data 
:  PR 
7 


720,  730,  75v  , 


760 


area  ter 


INT  S3*  : 

,  22  : 


:  60  i'0  b 


GOTO  620 
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78?  NEXT  I 

79?  FOR  I  =  1  TO  NODELVLS 

8??  LOCATE  15,7  :  PRINT  STR*(I) 

81?  IF  EXISTING  =  i?  THEN  LOCATE  IS,  :  PRINT  Si*  :  LOCATE  :6.c?  : 

PRINT  Si*  :  LOCATE  17,  £?  :  PRINT  Si*  :  LOCATE  19.  E?  :  PRINT  S2*  : 
uOCATE  Ei?,  :  PRINT  SE*  :  GOTO  06? 

83?  X ROW  *  IS 

83?  FOR  J  =  1  TO  3  :  LOCATE  XROW, 2?  :  PRINT  LEVEL DEFn*  {  I,  J)  :  xROW  *  XROW 

:  NEXT  J 


84?  XROUI  ■  19 

85?  FOR  J  *  1  TO  E  :  LOCATE  XROW, 2?  :  PRINT  SHORTFn* ( I , J >  :  X ROW  =  XROW  ♦ 

NEXT  J 

86?  XROL  *  15 

87?  FOR  J  *  1  TO  3 

88?  LOCATE  XROW, 19  :  LINE  INPUT  **  " ,  STUFF*  :  X  ROW  *  XROW  -  1 

085  IF  LEN (STUFF*)  *  ?  THEN  GOTO  9£? 

89?  IF  STUFF*  »  "quit “  THEN  GOTO  1??? 

9??  IF  STUFF*  »  "r.ext"  THEN  GOTO  99? 

9?5  IF  STUFF*  =  ”  THEN  STUFF*  * 

91?  LEVEL DEFN* ( I , J )  =  STUFF* 

9E?  NEXT  J 

93?  XROW  *  19 

940  FOR  J  =  1  TO  E 

95?  LOCATE  XROW,  19  :  LINE  INPUT  "  ”, STUFF*  :  XROW  *  XROW  ^  1 

951  IF  LEN ( STUFF  * )  =  ?  THEN  GOTO  98? 

955  IF  STUFF*  *  "Quit*'  THEN  GOTO  1??? 

96?  IF  STUFF*  =  "r.ext"  THEN  GOTO  93? 

965  IF  STUFF*  *  THEN  STUFF*  =•  " " 

97?  SHORTFh* ( I , J )  =  STUFF* 

98?  NEXT  J 

99?  NEXT  I 
1???  RETURN 
I?l?  * 

1?E?  *  *'ead  data  in  existing  file,  if  any 
1?2?  * 

1?4?  NODEFILE*  =  DR  I  VE*+ :  N" +NODENUM* 

1 ?5?  ON  ERROR  GOTO  1 39? 

I  ?6?  OPEN  NODEFILE*  FOR  INPUT  AS  *  1 
1  ?7?  EXISTING  *  +  1 

1?8?  INPUT  *1,  NODENUM*,  NODENA.^E* ,  NODEFM*  (  l  )  ,  NODEFm*(c>,  \ODEDER \%  <  l  )  , 
NODEDEFN* (E)  ,  NODEDEFN* (3>  ,  NF  ACS.  NODEMSRE  * ,  NODELVLS 
1  ?9?  FOR  I  *  1  TO  NODELVLS 

1  *  ??  Input  a  i  ,  l  E  Vt.wui'r!,  *_E  vEl  DEF  n*  <  j ,  i  )  ,  lE  vEl.  DEc  ns  <  ] ,  2 ) ,  lEvEi.  0EFN*ii,3), 

SHORTFH*  (  I  ,  1  )  ,  SHORT-H*  (1,2) 
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,110 
,  1  20 
1  1  30 
1  1  40 
1  150 
1  160 
1  170 
1  160 
1  190 
1  £00 
1210 
1220 
1230 
1240 
1250 
1260 
1270 
1275 
1280 
1290 
1300 
1310 
1  320 
1330 

1  340 
:  350 

1360 
1370 
1  380 
1290 
1  400 
1410 
1  420 

1430 
1  440 
1450 
1  460 
1470 
1460 
1490 
1500 
1510 


NEXT  1 
CLOSE  i 

»  1 

LOCPTE 

3, 

22 

PRINT 

NODENPMtS 

LOCPTE 

4, 

22 

PRINT 

nodefms ( 1 ) 

LOCPTE 

5, 

22 

PRINT 

nodEFms (2) 

LOCPTE 

6, 

CO 

PRINT 

NODEDEFNS ( 1  ) 

LOCPTE 

7, 

22 

PRINT 

NODEDEFNS (2) 

LOCPTE 

a, 

22 

PRINT 

NODEDEFNS (3) 

LOCPTE 

9, 

21 

PRINT 

NF  PCS 

LOCPTE 

10 

,22 

:  PRINT 

NODEMSRES 

LOCPTE 

i  i 

,  21 

:  PRINT 

NQDELVLS 

LOCPTE 

15 

,  8  : 

:  PRINT 

"  1  " 

i-OCPTE 

15 

,  20 

:  PRINT 

LEVELDEFNS (1,1) 

LOCPTE 

16 

,  20 

:  PRINT 

LEVELDEFNS (1,2) 

LOCPTE 

17 

,  20 

:  PRINT 

LEVELDEFNS (  !  ,  3> 

LOCPTE 

19 

,  20 

:  PRINT 

SHORTEMS (1,1) 

LOCPTE 

20 

,  20 

:  PRINT 

SHORTFMS (1,2) 

LOCPTE 

RETURN 

22 

,  10 

:  PRINT 

Enter  .  (full  st  CD ) 

’  pr  i  nt  noae 


to  Ceiete  *  f  ieio. 


’  wnte  records  ana  close  flies 

i 

open  nodefiles  for  output  as  *: 

WRITE  «  l ,  NODENUMS,  NODENPMEs,  nodEFms  <  l  )  ,  NODEF.r  s  ( 2)  ,  NODEDEFNS  t  l  ) , 
NODEDEFNS  (2)  ,  NODEDEFNS  (  3)  ,  NFacS.  nCDE^SkFs,  \OOcu 
for  I  =  1  TO  NQDELVLS 

write  m,  I  ,  LEVEL  DEF  NS  (  1  .  1  )  ,  LEvElDEFns  (  I  ,  2  >  .  L-EvEc  dlfns  (  1 , 3;  , 

shortens ( i , i ) ,  shortens  t i , 

NEXT  1 

close  *i 

RETURN 


•  error  n«ridl  ing 

t 

IF  ERL  =  1060  PND  ERR  *  52  ThEn 
EXISTING  =  0  :  RESUME  1280 

LOCOTE  20,  10:  PRINT  "erl  is  ,  STRS(ERl/,  err  is  ",  STRS(E4^> 
LOCPTE  21,10  :  PRINT  "END  OF  PROGRPM  IN  ERROR  HPnDLInG' 

END 


’  er>a  of  program 


CLS 

LOCPTE  10, 10  :  PRINT  "SUCCESSFUL  END  OP  PRQGRPm 
END 
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Program  Name: 

STF30 

La  nguage : 

BASIC 

Machine : 

Compaq  Person  Computer  (IBM  compatible) 

Purpose : 

This  program  is  a  utility  that  supports  the  data  collection 
effort.  It  prints  the  questionnaires  required  for  data 
col  lection . 
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1  ft  ’  THIS  P’ROo ^ "it  -  ;  b  h  \  j  -’  W  *  T  S  »-  U’  _j  :  S  '  ..  NN  A  J  A  h.  , 

50  ’ 

AO  ’  PROGRAM- ] D.  Sir -50, 

so  ’  date-written.  torch.  ;965 


60  ’  INSTALLATION.  C.;>'HW  «  :m.. 


70  ’  ACCOUNT.  J 1 87-0 ! . 

80  * 

90  CLEAR  ,  ,  8132 

100  GOSUB  330 

1 10  FOR  I  =  1  TO  NF ACS 

130  GOSUB  4  JO 

130  GOSUB  550 

140  NEXT  I 

150  GOSUB  660 

160  GOSUB  1090 

170  FOR  I  -  1  TO  NF  ACS 

180  GOSUB  1740 

190  NEXT  I 

300  IF  NFACS  *  3  THEN  GOSUB  1880 

310  IF  NFACS  *  4  THEN  GOSUB  3030 

330  GOSUB  2430 
330  1 

240  ’prompt  for  node  number  and  read  nodef  l  le. 


*  Get  node  da t  a 
’ Get  f act  or  da t  a 


* Or i n t  one  ways 
’print  two  ways 

’•'educe  o  l  mens  l  or  s 

*  print  tnree-ways 
’print  fout'-ways 
’ End  of  job 


250  ’ 

£60  PCOUNT  =  1  :  ON  ERROR  GOTO  2540  :  C^S 

270  OPTION  BASE  1 

280  DIM  NODEFMS (2)  ,  NODEDEFNS (3)  .  FACNAMEs (5) . FACrns (5, 3> , FACDE 
FACMSRES  (5>  ,  FACLEVELS  (5)  ,  LEVEL DEFS  (5.5,3),  ShGRTFms  (5. 

390  LOCATE  8,4  :  PRINT  “ST^-30.  M 
300  LOCATE  10,4  :  PRINT  "This  program  prints  a  questionnaire." 

310  LOCATE  12,  a  j  print  "C  lease  enter  drive  files  are  or..” 

220  LOCATE  1  a ,  A  :  PRINT  "Please  enter  (output)  node  r.i.imoer,  ” 

350  LOCATE  12, AS  :  INPUT  ”  , DRIVES 

3A0  IF  NOT  (DRIVES  =  *' a  ‘  OR  DRIVES  =  "d”  OR  DRIVES  *=  A  OR  DRIVES  = 
THEN  BEEP  :  LOCATE  20,  10  :  PRINT  "Drive  roust  be  A  or'  B  or  a  or*  b. 
GOTO  330 

550  LOCATE  1A,  A5  :  INPUT  "  ',  NODENUMS 

260  IF  NOT  LEN (NODENUMS )  =  7  THEN  BEEP  :  LOCATE  20,  10  : 

P'RINT  "Node  number  must  nave  seven  digits.  "  :  GOTC  250 

270  NODEFILES  =  DRIVES  +  "jn”  ♦  NODENUMS 
280  OPEN  NODEFILES  FOR  INPUT  AS  « I 

230  INPUT  #1.  NODENUMS,  NODENAMES,  NODEFMS(l),  NODEFms (2 ) ,  N0r2DEFNf( 
NODE  DEFNS ( 2 ) .  NODE DEFNS ( 2 ) .  NFQCS,  NCDEmSRE* 


A 00  CLOSE  *1 

A10  ASTERISKS  =  "  "  «*•  STR  I  NGS  (78,  '  *  ”  > 

A30  RETURN 
A30  ’ 

A  A  0  ’ generate  factor  numoer. 

A50  ’ 

AGO  IF  NODENUMS  =  ”0000000”  T hEn 

FACNUMS  =  RIGHTS  (STRS  (!>,  l  )  ♦  "OOOOOO”  :  RE~uRn 

a70  RESTS  =  NODENUMS 
A 80  FOR  J  *  1  TO  7 
A30  DIGITS  =  LEFTS(RES  s,;i 
500  RESTS  *  RIGHTS ( RESTS.  (  7- J >  ) 

510  IF  DIGITS  =  ”0  "hen  GCTC  520 


530  NEXT  J 
520  FACNUMS 

540  RETURN 


LEFTS  (  NuDCni  .ms,  (  J  -  :  >  )  ♦  MSTStCi.  i) 

♦  R  1  GhtS  (NODENUMS.  c  7  -  .j  >  ) 


B 


) 
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il  in 


55*  * 

56*  ’re^d  factor  r.oae  file 
57*  ’ 

58*  FACFlLE*  *  D^IVE*  ♦  t  N  "  *  FACNUM* 

53*  OPEN  F  ACF  I  LE*  FOR  INPUT  AS  ft  1 

6**  INPUT  •l.F  ILLER*.  EACNAmE*  <  I  >  ,  FACFms  (1,1),  FACFM*  <!,*=:>,  FACBEFn*  i  I  ,  1  )  . 

FACDEFN* ( Itc) , FACDEFN* (1,3),  FILLER, FACMSRE* ( I ) .  FACLEVELS  < I  ) 

61*  FOR  J  *  1  TO  FACLEVELS(I) 

62*  INPUT  »  1  ,  FILLER,  LEVELDEF*  (  I  ,  J,  1  )  ,  LEVELDEr  *  (I,  Jfi),  LEVELDEF*  (  1  ,  J,  3)  , 

SHORTFM* ( I ,  J,  1  )  , SHORTFM* ( I ,  J ,  2  > 

63*  NEXT  J 
64*  CLOSE  *  1 
65*  RETURN 

eee  ’ 

67*  ’print  or»f-«ay4 
66*  * 

63*  lPRINT  CHRS  (37)  ;  CHR*  (  43)  : 

LCOUNT  *  *  :  TUOUAYS  =  0  :  THREEWAY  =  *  :  EOURWAY  «  * 

7**  HLINE1S  -  STRI NG*  <  65,  "  “)  ♦  "Q:"  ♦  NODENUM* 

71«2i  HLlNEc*  =  STRING* <65, "  “ )  ♦  “rj  _ "  :  GOSUB  £27* 

7£*  PLINE*  *  “In  the  following  questions  you  are  given  a  single  oiece  of  inform* 
t ion. "  :  GOSUB  22 1 * 

73*  PLINE*  *  "For  each  question  please  give  your  Pest  estimate  of  "  ♦ 

NODE NAME*  ♦  M."  :  GOSUB  £21* 

74*  GOSUB  3ili?  :  PLINE*  *  "Please  respond  "  ♦  NODEMSRE*  :  GOSUB  ££10 
76*  FOR  I  *  1  TO  NF ACS 

77*  IF  LCOUNT  )  (65  -  (11  +  F ACLEVELS < I > *5 ) >  THEN  GOSUB  £27* 

78*  GOSUB  £21*  :  PL  I NE*  =  "Consider  levels  of  this  factor:  "  : 

GOSUB  22 10  :  GOSUB  22 1® 

73*  FOR  J  *  1  TO  3 

8**  PLINES  *  STRI  NG*  (  15,  **  "  >  ♦  F  ACDEFN*  (  I ,  J  )  :  GOSUB  2210 

81*  NEXT  J  :  GOSUB  £21* 

82*  PLINE*  *  STRING*(73,  '  ‘  > 

83*  Ml Ds (PLINE*.  1*>  *  "LEVEL" 

84*  M I D* (PL  I NE*, 38 )  =  "(Short  Form)" 

85*  MI D* (PLI NE*.  65)  =  "OUTPUT" 

86*  GOSUB  ££ 1  *  :  GOSUB  £21* 

87*  GOSUB  93* 

88*  NEXT  I 
89*  RETURN 
9**  ’ 

31*  ’print  factor  levels  and  response  lines 
32*  ’ 

33*  FOR  J  *  1  TO  FACLEVELS ( I > 


34* 

GOSUB  ££ 1  * 

35* 

FOR  K  »  1  TO  3 

36* 

PLINE*  *  STR I NG*  <  73,  "  " ) 

37* 

MI D* (PL INE*, 1 , 4*>  =  LEVELDEF* ( I , J, K) 

33* 

IF  NOT  <K  *  1)  THEN  MI D* (PL INE*, 42)  = 

SHORTEM* ( I , J,  <K 

1  *** 

IF  K  *  3  THEN  M I D* (PL  I NE*,  58 )  =  " 

" 

1  *  1  * 

GOSUB  £21* 

1  *£* 

NE  X  T  K 

1  *3* 

GOSUB  £21* 

1*4* 

NE  1 1  J 

1*5* 

GOSUB  22 ! *  :  P L I NE*  =  ASTERISK*  :  GOSUB  £21* 

:  GOSUB  £21* 

1  *6* 

RETURN 

GO 


1*7*  1 

1*8*  *  print  two  ways  (factor'  with  most  levels  goes  dowr,  t  sage) 

1*9*  1 

11**  TWOWPYS  =  *1  :  NWPY*  =  "two" 

111*  K  *  * 

112*  ’ 

113*  1 
114*  * 

115*  FOR  I  =  (KM)  TO  (NFPCS-I) 

116*  FOR  J  =  <I+1>  TO  NF  ACS 

117*  IF  FOCl-EVELS(I)  )  FftCLEVELS(J)  THEN  11  =  1  :  JJ  =  J 

ELSE  II  ■  J  :  JJ  »  I 

118*  GOSUB  122* 

119*  NEXT  J 

IE**  NEXT  I 
1£1*  RETURN 
1 2c*  * 

1  £3*  IF  (  (LCOUNT  )  (65  -  (  1  *  -  F  AC  LEVELS  ( I  1 ) »5  >  )  >  CR  (TWOWPYS  =  *►  1  >  > 

THEN  GOSUB  £27* 

124*  IF  (TWOWPYS  =  +1)  THEN  GOSUB  212* 

1250  GOSUB  121*  ’print  text  header's  across 

126*  FOR  RESPBLOCK  =  1  TO  F PCLE VELS (  I  I ) 

127*  GOSUB  157*  ’print  resoorse  bloc* 

128*  NEXT  RESPBLOCK 

129*  IF  ( ( THREEWPY  =  +1)  OR  (FOURWPY  =  +  1>>  THEN  GOSUB  221*  : 

PLINE*  *  ASTERISK*  :  GOSUB  221* 

13**  RETURN 
1310  ’ 

132*  ’print  text  header's  across 
133*  ’ 

134*  GOSUB  221*  :  GOSUB  221* 

135*  IF  (FOURWPY  =  ♦ 1 >  THEN  PLlNE*  =  CHR* ( 3 1  > -- PCFn* ( l ,  1  ) » “  ♦FPCFr *  rL, c)  ♦ 
CHR* ( 3* ) ♦ "  is  FIXED  at  " +CHRS ( 3 1 > ♦SHORTFM* ( L,  LL  ,  !)♦'  ' ♦SHORTEN * ( L •  LL ,  2  )  * 
CHR* (3*) 

136*  GOSUB  221*  :  GOSUB  221* 

137*  PLINE*  *  STRING*(3*."  " )  *  FPCNPME*(JJ>  ♦  :  GOSUB  221* 

138*  PLINE*  =  STR ING* ( 3*, "  " )  ♦  STRING* (LEN (FPCNPME* (JJ) ) , )  :  GOSUB  221* 

139*  PL  I NE*  =  ST R I NG* ( 79,  "  ") 

14**  FOR  ROW  =  1  TO  2 

141*  FOR  COL  =  1  TO  FPCLE VELS ( J J ) 

142*  MID*  (PLINE*,  (31  +  1  1*  (COL-1  >>,  10)  =  SHOR  TFM*  (  J  J ,  COc. .  ROW  > 

143*  NE X T  COL 

144*  GOSUB  221* 

145*  PLINE*  *  STRI NG*  (  79,  *’  "> 

146*  NEXT  ROW 
147*  * 

148*  FOR  ROW  =  1  TO  2 

149*  IF  ((ThREEWPY  =  +1)  OR  (-OURWPY  *  ^ 1 > ) 

THEN  M I D*  (PL  I NE *.  1 ,  1  * )  =  FACFM*  ( K,  ROW) 

15**  MID* (PL InE*,  12,  1*>  =  FPCFh* ( I  I , ROW ) 

151*  GOSUB  221* 

152*  PLINE*  =  STRING*  ( 79,  ••  •) 

153*  NEXT  ROW 

154*  IF  ((THREEWPY  *  *1)  DH  iFQURwPY  *  ♦*>)  1-t.N  M 1 D*  ( *■"-  -  ----- 

155*  MID*  (PLINE*,  12)  =  " - •'  :  ^uSUB  2*2  1  * 

156*  RETURN 


100 


1570 

1580 

1530 

1600 

1650 

1660 

1670 

1680 
1  700 

17  10 
1720 
1725 
17  30 
1  740 
1750 
1760 
1770 
1  780 
1730 
1800 
1810 
1820 
1830 

1840 
1850 
I860 
1870 
I860 
1830 
1300 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
1380 
1330 
2000 
2010 
2020 
2030 
2040 
2050 
2060 
2070 
2080 
2030 
£  1  00 
2110 


’print  resoonse  DlOC* 

GOSUB  2210 

FOR  ROUI  *  1  TO  2 

-•LINE*  *  STRINGS  <  7  3,  •  ‘  ) 

IF  ((THREEUiftV  *  ♦  l  >  OR  (FOURUIPY  -  «■  1  )  > 

THEN  HI  D*  (C-L  I  NE*,  !  ,  10)  *  SHORTFM*  <  K,  KK,  ROW ) 

HI  D*  (PL  INES,  1  2,  1  0>  =  SHORTFw*  (  I  I ,  RESP&LOCK,  ROLi) 

IF  ROW  =  2  THEN  FOR  COL  *  1  TO  FPCLE VELS ( J J )  : 

h  I  D*  (  PL  I NES,  ( 30  ♦  11*1  COL—  1  )  )  ,  10)  *  ** _  "  :  NEXT  CC'L 

GOSUB  2210 
NEXT  ROW 
GOSUB  2210 
RETURN 

1  reduce  oiriiensions  :  five  factor  levels  to  three 

t 

IF  FPCLEVELS(I)  (  5  THEN  RETURN 

FOR  J1  *  3  TO  5  STEP  2  :  GOSUB  1810  :  NEXT  J1 

FPCLEVELS(I)  *  3 

RETURN 


’  for  5  factor  .eve  is  shift  3  to  2  and  5  to  3 
IF  Jl  =  3  THEN  J2  =  2  ELSE  J2  «  3 

FOR  K  «  1  TO  2  :  LEVEL DEF* ( I , J£, K)  =  LE VELDE F* ( I , J 1 , K )  :  NEXT  K 
FOR  K  -  1  TO  2  :  SHORTFH*  (  I ,  J£,  K  )  =  SMORTFH*  (  I ,  J  2  ,  K)  :  N2  X ""  X 
RETURN 

’  print  three-ways 


TWOWPYS  =  0  :  THREEUPY 
L  =  0 


' I  :  NUPYS  *  •‘three’’  :  GOSUB  2270  :  GGSuB  2120 


FOR  K  *  ( L ♦ 1 )  TQ  (NFPCS-2) 

FOR  KK  =  1  TO  F PC»_E  VELS  (  K ) 
GOSUB  1150 
NEXT  KK 
NEXT  K 
RETURN 

i 

*  print  four ways 


WOhPYS  =  0  :  FOURWPY  *  ♦!  :  NLIPV* 

FOR  L  =  1  TO  (NFPCS-S) 

FOR  LL  =*  !  TQ  FPCLEVElSClJ 

GOSUB  1 360 

NEXT 

NEXT  L 
RETURN 


‘  f  our 


GOSUB  2270 


GG3v_  B  2  1  20 
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print  n— wa y  heading 


£120  1 
2130  * 

2140  ’ 

2150  PLINE*  =  "On  these  pages  you  are  giver.  ♦  NUfiV *  * 

"  pieces  of  information  together,  "  ;  30SUB  22 1/1 

2160  PLINE*  *  "For  each  Question  please  give  you*'  Pest  estimate  oh 
NODENftME*  *•  "  :  GOSUE*  22 10 

2170  GOSUB  22 1 0  :  PLINE*  *  "Please  respond  "  ■»  NGDc-^SRE*  :  3GSJB  2217' 
£  1 90  GOSUB  22  1C 
22710  RETURN 
2210  1 

2220  ’print  one  line 
£230  ’ 

2240  LPRINT  =’LINE*  j  PLINE*  =  "  " 

2250  LCOUNT  *  LCOUNT  ♦  1 
2260  RETURN 
2270  ’ 

2280  ’page  area*. 

2290  ’ 

2200  LPRINT  C h R s ( 12)  :  -COUNT  =  5 

2210  LPRINT  HLINE1*  :  PLINE*  =  "  "  :  LPRINT  PlInE*  :  uP«’NT  mL  I NE 2  t 

2220  LPRINT  PUINES 
2330  RETURN 
2240  ’ 

2250  ’  error  handling 
2360  ’ 

2370  IF  (ERR  -  52  PND  LEN ( FQCF I LES )  =  0)  THEN  LOCP^E  20.^  : 

P'RINT  "File  not  found.  Please  re-ente>  crive  ar.o  node.  "  :  RE3LV 

2380  IF  (ERR  =  52  GND  LEN  ( c^CF  I LE* )  )  0)  ~HE*«  _uCP~E  20,**  : 

PR  I NT  ’Factor  file  FACFILE*;  ”  not  f  :uno.  Ptanc  r  i  r.g  Process 
END 

2290  LCCP’E  20,10  :  PRINT  "eri  is  "  ;  STR*<£R->;  e  •  ;  s  ;  3  r  R*  < 2  =?*? ) 
2400  ^0CPTE  21,  10  :  PRIN~  end  of  program  ir  error  hand  i  ng.  " 

2410  END 
2420  ’ 

2420  ’  erd  of  program 
2440  ’ 

2450  C»_S  :  c-CCPTE  10,  !0  :  PRINT  "Successful  erp  oA  progr  am. 

2460  END 
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Program  Name: 

STF40 

Language : 

BASIC 

Machine : 

Compaq  Personal  Computer  (IBM  compatible) 

Purpose : 

This  program  is  a  utility  that  supports  the  data  collection 
effort.  Questionnaire  responses  can  be  entered  into  a  file 
using  this  program. 
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10  ’ 

30  * 

THIS  PROGRAM  ACCEP  r?  DA'a  Rr*  A  OuEf 

j T 1  cwRi  r r  and  +* r  i  ~  s 

30  ’ 

PROGRAM-ID. 

40  ’ 

DATE-WRITTEN.  MARCH.  1365 

50  1 

INSTALLATION.  Alpha TECH.  INC. 

60  ’ 

70  1 

ACCOUNT.  J187-01. 

80  C 

1LEAR  ,,8  133 

30  GOSUB  360 

*  Get  node  da t  a 

1  00 

FOR  I  =  1  TO  NF  ACS 

’Get  factor  oat? 

1  1  0 

GOSUB  460 

130 

GOSUB  5G0 

130 

NEXT  I 

1  40 

GOSUB  740 

*  ooer  :>ut  put  f  i  *  e 

150 

FOR  RESP  =  1  TO  NUMRESP 

160 

GOSUB  850 

’reset  factor  ieve,s 

1  70 

GOSUB  1000 

’  co  one  ways 

180 

GOSUB  1530 

*  do  t  wo  ways 

1  90 

FOR  I  *  1  TO  NF  ACS 

300 

GOSUB  3330 

*  reduce  dimensions 

310 

NEXT  I 

330 

IF  NFACS  =  3  Then  GOSUB  3540 

’  do  t  nr*ee- ways 

330  Ir  NF PCS  *  4  THEN  GOSUB  3680  *  or  do  four- ways 

340  NEXT  RESP 

350  GOSUB  3360  ’End  of  job 

360  ’ 

370  ’  proMDt  for  node  riMMber  and  read  rocef  i  le. 

380  1 

330  ClS  :  ON  ERROR  GOTO  3330  :  OPTION  BASE  1 
300  LOCATE  8.  4  :  PRINT  STF-40.  •* 

310  LOCATE  10,4  :  PRINT  n  i  s  acceots  data  from  a  cuest  ;  :«r.^aire. 

230  ^OCATE  13,4  :  PRINT  P  j  ease  er,  t  e**  drive  flies  are  or,.  ' 

330  LOCATE  14,  L  :  PRINT  Please  enter  o* test l onna l re  number.  " 

340  LOCATE  18,4  :  PRINT  'Please  enter  totai  number  o*  res  concent  s.  ' 

350  LOCATE  13,45  :  INPUT  "  ",  DRIVE* 

360  IF  NOT  (DRIVE*  »  "a*  OR  DRIVE*  =*  •*&M  OR  DRIVE*  *  A  OR  DRIVE*  =  "B") 
^HEN  BEEP’  :  LOCATE  30.  10  :  P'RINT  "Drive  must  be  A  or  B  or  a  or  b.  : 
GOTO  350 

370  LOCATE  14.45  :  INPUT  •'  ",  NQDENUHi 

380  IF  NOT  LEN  (NODENur**)  -  7  ThEN  BEEP'  :  LOCATE  30,10  : 

P'RINT  "Ncce  number  roust  Have  sever,  digits.  "  :  GOTO  370 

390  bOCATE  16.45  :  INP'U~  "  '\RESPNUM*  :  NUMRESP'  »  VAL < RESPNUM* ) 

400  IF  NOT  (N'jhRESP'  )  1  AND  NU^RESP  <  6)  THEN  BEEP'  :  LOCATE  30,  10  : 

PRINT  Number*  of  respondent  s  must  be  between  3  ar.c  6.  :  GOT  3  390 

410  NODEFILE*  =  DRIVE*  -  '  :N"  -*•  nQDENUM* 

4c 0  OPEN  NODEFILE*  FOR  INPUT  AS  -1 

430  I NPMJ”  *1.  nODENU**,  nODENAtE  * ,  n'ODZFms  (  1  )  ,  nODEF  ( £  ,  NODE  DE~  i  *), 
NODEDEcN*  <  3  )  ,  N'CDEDtFN*  (.3)  ,  NF  ACS.  NODE  RE* 

440  CLOSE  *1 
450  RcTJRn 
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-60  ’ 

-70  ’  qer.erate  factor  r.Mf.mef . 

4  80  * 

490  IF  \CDEnum*  =  "MM*#*-' 

hSCNu^S  *  RIGH:S(S7R*<!),  1)  ♦  ••  ^  ••  :  RETURN 

500  REST  t  =  nODEnUM* 

510  FOR  J  *  1  70  7 

560  DIGIT*  *  LEFT*  C  REST*,  1  ) 

530  WEST*  =  RIGHT* ( REST*.  (7-J>) 

540  IP  DIGIT*  *  "0"  ~h£n  goto  see* 

550  NEXT  J 

560  FOCNUM*  *  LEFTS (NODENUT*, (J-l) )  -  RIGHT* ( STR* < I ) , 1 ) 

♦  ,RI  GHT*  (NODENUM*,  (  7- J  )  ) 

570  RETURN 
580  ’ 

590  ’read  factor  r..;*Oe  fi  .e 
600  ’ 

610  FACFILE*  *  DRIVE*  ♦  "sN"  ♦  FACNUM* 

630  OPEN  FACF I LE*  POR  INPUT  AS  HI 

650  INPUT  *  1 , PPCNUM* (  I  )  , FAC NAME* ( I )  ,  FACFM*  Cl,  l )  ,  FACFm* (1,6), FACDE.-N*  (  : 

PACDEPN* (1,6), PACDEPN* (1,5),  FILLER, PACKS*-* ( I ) , FACLEVElS 
640  POR  J  *  1  TO  PACLcVELS(I) 

650  INPUT  *1  ,  FILLER,  lEVELDEP*  (  I,  J,  1  )  ,  LE  VENDER*  (  I,  J,  5)  ,  <-EVEi_DEF*  (  I , 

SHORTPM* ( I , J , 1 ) , SHORTFM* ( I , J, 6) 

660  SAVElEvELS ( I )  -  PAClEVELS(I)  :  LE VE ^NUM ( I , J )  *  J 

670  FOR  K  “  1  TO  3 

680  SAVEDEF*  (  I ,  J,  K)  =  I.E  VElDE  F*  (  I ,  J,  K  ) 

630  IP  K  <3  THEN  SAVEFM* (  I ,  J.  K )  =  SHORTFM* ( I ,  J.  K I 

700  NEXT  K 

710  NEXT  J 

760  CLOSE  «1 

730  RETURN 


740 
750 
760 
770 
780 
730 
800 
810 
860 
830 
840 
850 
860 
870 
880 
830 
300 
310 
360 
330 
34  0 
350 


’  oo en  output  file 

QPILE*  =  DRIVES^”  : O’* ♦nGDEnum* 

OPEN  OFILE*  FOR  OUTPUT  AS  *  1 
QNUM**NODE\UMS 

PRINT  H  1  ,  R  IG*“T*  (STR*  (NCACS  )  .  1  > 

STUFF*  *  MM 

FOR  I  =  1  TO  NF ACS  :  STUFF*  «  STL-F*  ♦  R I GHT* ( ST R* ( F AClEVE lS (  ;  )  ) 
PRINT  »*1,  STUFF* 

RETURN 

V 

’reset  levels  of  factors 

FOR  ;  *  1  TO  NF  ACS 

IF  SPVELEVELS ( I )  <  5  THEN  GOTO  380 

-OR  J  -  1  TO  5 
LEvElNUM  (  I  ,  J)  *  J 
FOR  K  *  1  'rO  3 

LSVELDFF* ( : , J. Ki  *  SAVEDEF K : . J, K) 

IF  k  (5  s  -» o  R  r  c  m  *  <  J ,  .  t  ,  k  )  =  Sflvf-^*(1.  u 

NEXT  <  * 


960  next  ; 

970  -flC^EVt  S  (  i  )  -  SAVE  ..EVE  .  S  (  .  > 

300  NEXT  I 
330  RETURN 


105 


1  000 
1010 
1020 
t  *30 
;  040 
1050 
i 

1070 
1080 
1030 
1  1  00 
111® 
1  1  20 
1  1  3U 

1  1  41? 

I  150 

I I  60 
1  1  7i? 
1  1  8i? 
U3i? 
1  £(?(? 
1210 

1  230 
1341? 

1250 
1260 
1270 
1280 
1230 
1300 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
1380 
1330 
1  400 
1410 
1  420 
1  430 
1440 

1450 
1460 
1470 
1480 
1  430 


'flo  one  ~ays 


~,~<RGFWAv  s  0  :  FCHjRHHY  -  ? 

FOR  I  -  „  TC'  NfnCS 
XRQ*  =  1  :  CVS 

PL  InE*  ~  S I  R I  nG*  (  70,  ")  ♦  "Q:  ♦  nODENUm*  :  GOSVb  j 
►’LINE*  =  STS  I  \G*  (70.  M  "  )  -  "  Re  so :  "  ♦  STRs<RESP>  :  GOo-b  2  .*80 
GO  Si;  8  2780 

PL>E*  =  Set nor.se  is  -  nODEnAmE*  :  GOSUb  2780 

PLINE*  =  "Factor  is  "  -  c HCNAME* < I )  :  GOSUb  2780  :  GOSUb  ,78v 

PLlNE*  «  STRING* (73,  > 

M  I  D*  (Pl.  I  NE*,  1  0  )  -  LEVEL' 

MI  D*  (PL  INE*,  36)  =  "(Short  rorw)  '* 

MID* (PLINE*. 50)  =  "RESPONSE" 

GOSUb  2780 
GOSUb  1200 
GOSUb  1340. 

NEXT  I 
RETURN 

’oririt  factor  leve  s  arc  resjor.se  ir.es 

SPVEROwj  «  CSRuIN 

FOR  J  =  1  TO  cftCLEVELS(I) 

FDR  K  =  1  TO  3 

PLINE*  =  STRING* (73,  ‘  " > 

MID* ( PL  I NE*, 5, 30 >  =  wEVELDEF* ( i,J,K) 

IF  N0T  <K  *  1)  THEN  M  I  D*  (Pl  I  NE*,  26  )  =  SHORT  r  M*  (;,  J  .  (*-, 

Ip  K  =  3  THEN  MID*  (PLINE*,  50, 20)  =  " _ ' 

GOSUb  27b0 
NEXT  K 
NEXT  J 
RETURN 


1  get  res  oor.se  s 

. 

X  ROW  =  SAVERGU 

FOR  J  *  1  TO  FPCLEVELS(I) 

FOR  K  *  ;  TO  3 

IF  NOT  <K  =  3)  THEN  GOSub  2780  :  GOTO  14fc0. 

FOR  QN  »  i  TO  5  :  Q ( ON )  *  0  :  NEXT  Qn 

^OCPTE  CSRL IN, 50  :  INPUT  S~UFC* 

0(1)  =  J 

QID*  =  :  FOR  ON  =  1  TO  5  :  DID*  *  O I D*  ♦  R I  Ght*  < ’sT **  l.  (On)), 

:  NEXT  ON 

GOSUb  2640 
NEXT  K 
GOSUb  2780 
NEXT  J 
RETURN 
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1  5**  ' 

151*  *  o-int  t^>:<  Mjtys  (fictor*  witn  Most  .evH»is  goes  cow.  np  r>> 

,52*  ‘ 

:53*  ■<  =  *  :  TwOwAYS  * 

.54*  ’ 

155*  ’ 

156*  ’ 

157*  FOR  !  *  (<+l)  ”0  t.\FACS-l> 

15a*  for  j  =  <i*-i>  to  nfpcs 

153*  IP  FOCLEVELSCI)  >  FOC^EV£lS(J>  TrEN  II  =  I  :  JJ  =  J 

E^SE  II  «  J  s  JJ  «  ; 

j  £**  GCSUP  1641? 

161*  NEXT  J 

162*  NEXT  I 
163*  RETURN 

164*  * 

165*  xROw  *  3 

166*  GOSUP  .73*  •  pr :  rtz  text  neaaers  across 

:67*  SAVEROw  =  CSRLlN  :  RPTR  =  * 

168*  FOR  RESPPuOCK  =  1  TO  FAC_EVELS  <  I  I  > 

163*  GOSUP  2*6*  ’print  response  olC'C“ 

17**  NEXT  RESPPLOCK 

1 7 1 1?  IF  TWOWPYS  *  +1  OR  THREEWAY  *  -1  OR  FOURWAYS  *  ♦  1  THEN  ^OCO'E  33,  ’  *  : 

PRINT  M£nter  .  (full  stop)  to  s^ip  screen,  ..  (two  stops)  to  sRio  1  l  r.e 
172*  XROW  =  SAVEROW  :  RPTR  =  * 

173*  FOR  RESPPLOCK  «  1  TO  F ACLE VELS ( I  I > 

174*  STUFFS  *  " 

175*  GOSUP  22’**  ’get  responses 

176s?  IF  STUFFS  =  THEN  GOTO  178* 

1  77*  NEXT  RESPPLOCK 
178*  RETURN 
173*  ’ 

IS*?  ’print  text  Headers  across 
181*  ’ 

1 8c*  CLS 

1 83*  IF  (FOuRWfiv  *  ♦!)  Th£n  PlINES  *  “In  tHe  following,  "  ♦  FACNAr£S  ( •_  >  * 

is  fixed  at  ShORTP MS  (t,  ul,  1)  ♦  ”  ***  SHORTENS  (L*  LL,  c‘)  l  GOSUP  ^70? 

164*  -L.N'Et  *  STRING*  (73,  *'  >  :  l  DS  ( CL  I  NES,  EG  •  *  -AC NAME  S  ( JJ 1  :  GGSwC*  376* 

185*  Pi.lNES  =  S~R  I NGS  (  73,  M>  :  M  1  Ds  (Pl  I  NES,  35  >  *  STR  I NGS  ( UEN  (  FACNPME*  i  *  J  >  >  . 

:  GOSUP  278* 

166*  -LINES  *  STRINGS (73,  *  M ) 

: 8  7*  FOR  ROW  1  !  TO  2 

1 86*  -OR  CGu  =  1  TO  FAl^EVELS  ( JJ) 

l  83*  *»UB*  CPLINE*,  <2S>1  1  *  (COL-I  >  > ,  J*>  *  5H0R7FMS  (  J  J  ,  CO.  ,  ROW ) 

.3**  Nt  XT  lTu4- 

:?.*  GC SUP  278* 

1 32*  PlInES  =  STRINGS  (  73,  '•  > 

.33*  NEXT  ROW 
13  4*  » 

135*  *  3)  ieft  hand  sice  column  r.ead.ngs 

.36*  * 
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246® 

2470 

2480 

2490 

2500 

2510 

2520 

2530 

2540 

2530 

2560 

2570 

2380 

2390 

2600 

2610 

2620 

2630 

2640 

2630 

2660 

2670 

2680 

2690 

2700 

2710 

2720 

2730 

2740 

2750 

2760 

2770 

2780 

2790 

2800 

2810 

2820 

2830 

2840 

2850 

2860 

2870 

2880 

2890 

2900 

2910 

2920 


2930 

2940 

2930 

2960 

2970 

2980 

2990 

3000 

3010 


’for  5  factor  levels  shift  3  to  2  and  5  to  3 

IF  J1  =  3  THEN  J2  =  2  EuSE  J2  -  3 
LEVELNUM ( I, J2)  »  LEVELNUM ( I , J 1 ) 

FOR  K  *  1  TO  3  :  LEVELDEF* ( I ,  J2t K>  =  LEVELDEF*  <  I ,  J  1 ,  K  )  :  NEXT  K 
FOR  K  «  1  TO  2  :  SHORTFHSd,  J2,  K>  =  SHORTFh*  (  I ,  J  1 ,  K )  :  NEXT  K 
RETURN 

t 

’  print  three-ways 

TWOWAYS  «=  0  :  THREEWAY  «  >1 
L  *  0 


FOR  K  -  (L  ♦  1  >  TO  (NFACS-2) 

FOR  KK  *  1  TO  FACLEVELS (K  > 

60SUB  1570 
NEXT  KK 
NEXT  K 
RETURN 

i 

*  print  fourways 

f 

TWOWAYS  =  0  i  FOURWAY  -  >1 
FOR  L  «  1  TO  (NFACS-3) 

FOR  LL  *  1  TO  FACLEVELS (L> 

GOSUB  2620 
NEXT  LL 
NEXT  L 
RETURN 

i 

’ print  one  1 ine  on  screen 

LOCATE  XROW, 1  :  PRINT  PLINES  :  PLINES  = 

XROW  =  XROW  ♦  1 

RETURN 

t 

’  write  one  record  to  the  file 

i 

PRINT  #1,  QNUMS;  RI GHTS (STRS ( RESP> , 1 > ;  QID*;  STUFFS 
RETURN 

i 

’  error  handling 

i 

IF  (ERR  *  53  AND  ERL  *  420)  THEN  LOCATE  20,4  : 

PRINT  "Nodef  i  le  not  found.  Please  reenter  data.  *'  :  RESUME  350 

IF  (ERR  *  53  AND  ERL  =  620)  THEN  LOCATE  20,4  : 

PRINT  “Factor  file  “  ;  FACF  I  LE* ;  “  not  found.  Abandoning  process.  " 
LOCATE  20,10  :  PRINT  '  er  1  is  " ; STR* ( ERL )  ; “  err  is  “;STR*(ERR> 

LOCATE  21,  10  :  PRINT  ’*end  of  program  in  error  handling.  "  :  END 

t 

’  end  of  program 

t 

CLOSE  *1 

CLS  :  LOCATE  10,  10  :  PRINT  ‘Successful  end  of  program.  " 

END 


END 
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1370  FOR  ROW  *  1  TO  2 

i960  IF  ((THREEWAY  *  ^1>  OR  (FOURWAY  «  ♦ 1 ) ) 

THEN  MID* (PLINE*, 1, 10)  *  FACFM* ( K,  ROW) 

1930  MID* (PLINE*,  1£,  10)  *  FACFM* < I  I,  ROW) 

2000  GOSUB  2780 

2010  PLINE*  *  ST R I  N6*  (  79,  '*  M) 

2020  NEXT  ROW 

2030  IF  (  ( THREEWAY  *  *►  1  )  OR  (FOURWAY  =  +1))  THEN  M I D* ( PL  I NE*,  1  )  »  " - 

2040  nID*  (PLINE*,  12)  *  " - *  :  GOSUB  2780 

2050  RETURN 
2060  * 

2070  ’print  response  block 
2080  ’ 

2030  FOR  ROW  *  1  TO  2 

2100  PLINE*  *  STR  I N6*  (  79,  **  ") 

2110  IF  ((THREEWAY  «  M )  OR  (FOURWAY  *  +1)) 

THEN  MID* (PLINE*, 1, 10)  «  SHORTFM* ( K, KK, ROW ) 

2120  MID* (PLINE*,  1 1 ,  10)  *  SHORTFM* ( I  I ,  RESPBLOCK,  ROW ) 

2130  IF  ROW  *  1  THEN  GOTO  2170 
2140  FOR  COL  «  1  TO  F ACLEVELS < J J ) 

2150  MID*  (PLINE*,  (24^1  l*  (COL-1  )),  10)  *  M _  _ *' 

2160  NEXT  COL 

2170  GOSUB  2780 

2180  NEXT  ROW 
2190  RETURN 
2200  ’ 

2210  ’get  responses 
2220  ’ 

2230  FOR  ROW  «  1  TO  2 

2240  IF  NOT  (ROW  «  2)  THEN  GOSUB  £780  :  GOTO  £360 

2250  FOR  COL  *  1  TO  F ACLEVELS ( JJ ) 

2260  LOCATE  XROW,  (24+ 1 1  * (COL-1 ) )  :  INPUT  STUFF* 

2270  IF  STUFF*  *  "  THEN  BEEP  :  GOTO  2260 

2280  IF  (STUFF*  =  "  OR  STUFF*  *  ,  ” )  THEN  GOTO  2360 

2230  FOR  ON  *  1  TO  5  :  0<0N>  *  0  :  NEXT  ON 

2300  0(1  I)  «  LEVELNUM<  I  I,  RESPBLOCK)  :  O  <  J  J  )  «  LEVELNUM < J J, COL ) 

2310  IF  THREEWAY  *=  ♦  1  OR  FOURWAY  *  +1  THEN  Q(K)  »  LE  VELNUM  ( K,  KK ) 

2320  IF  FOURWAY  «  *1  THEN  0(L)  *  LE VELNUM < L, LL) 

2330  QID*  *  “*•  :  FOR  ON  »  1  TO  5  :  OID*  *  QI  D*  +  R  I GHT*  ( STR*  ( O  ( ON )  )  ,  l  ) 

:  NEXT  QN 

2340  GOSUB  2840 

2350  NEXT  COL 
2360  NEXT  ROW 
2370  GOSUB  2780 
2380  RETURN 
2330  ’ 

2400  ’  reduce  dimensions  :  five  factor  levels  to  three 
2410  » 

2420  IF  FACLEVELS(I)  <  5  THEN  RETURN 

2430  FOR  J1  *  3  TO  5  STEP  c  :  GOSUB  2460  s  NEXT  Ji 
2440  F ACLEVELS ( I )  *  3 

2450  RETURN 
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